&NN VTEDIT051.BM` VTEDIT051.BBACKUP/NOASSIST/COMMENT=VAX/VMS SPKITBLD Procedure/INTER/LOG/VERIFY DISK$MASTER:[WECK.VTEDIT.KIT.V51.B]*.* MSA0:[0,0]VTEDIT051.B/LABEL=(VTEDIT)/SAVE/IGN=LABEL/NOREWI/DENS=1600/NOINIT/NOREWIVAX/VMS SPKITBLD Procedure SYSTEM aXV5.1 _PISA::  _PISA$MSA0: V5.0  %*[WECK.VTEDIT.KIT.V51.B]STARTVTE.COM;4+,e./ 4D-)0123KPWO56`j7ߍ89GHJ$ !8$ ! Startup command file for the VTEDIT TPU-based editor$ !D$ DEFINE /SYSTEM /EXEC /NOLOG TPU$CALLUSER SYS$LIBRARY:TPUCALL.EXE$ !$*[WECK.VTEDIT.KIT.V51.B]TPUCALL.EXE;2+,l. / 4 -)0123 KPWO 56N27}89GHJ0DX0205*2 h TPUCALL01204-00  ! LIBRTL_001LNM$FILE_DEV !SWH,[}PQPЬ ԫϼB .ZЏ@ kޫ L1T P`P`P`Pޫ`P`lptPkkԫ1T lp˔ PRRlpˠl Pk/RPPlpRPP˨Bˬ˰? Pk1T ˨ˬ˼" Pk1T˨ˬPkkԫ1T˨ˬPQQ˨ˬPQQl@pPkkP2^Tp˨ˬvPQQ˨ˬPQQl@p-PkkP2 ˨ˬPkkPH[޼kмk@ЫP ,,D @ l H 8        d <    , d  , d  @@x x p80 H@   @LIBRTL"h p x |     $ , 0 4 @ D H X  TPU$CALLUSER TPU$CALLUSERW% \ TPUEXT \TPUEXT &DEFAULT_CLUSTER2TPUCALL0112-APR-1989 16:0612-APR-1989 16:06VAX-11 Linker V04-00 .$$ABS$$.!H TPU$CALLUSER$*[WECK.VTEDIT.KIT.V51.B]TPUCALL.FOR;1+,$. / 4I V-)0123KPWO 5627 089GHJ9C ***************************************************9C * *9C * INTEGER*4 FUNCTION T P U $ C A L L U S E R *9C * *9C ***************************************************C++IC Call_User Functions used by VTEDIT; the needed function is selected>C via the first parameter IDISP, used as a dispatch value:C>C IDISP = 1 : Disable Ctrl/T, setup exit handler for re-enab 8a_ VTEDIT051.B$)$[WECK.VTEDIT.KIT.V51.B]TPUCALL.FOR;1I *leC INSTRING: EmptyC OUTSTRING: The sameC%C IDISP = 2 : Translate logical name:-C INSTRING: Logical name to be translated!C OUTSTRING: Equivalence nameC-C IDISP = 3 : Create logical name translationEC INSTRING: Logical name and equivalence name, separated by spaceC OUTSTRING: EmptyCC IDISP = 4 : Delete file*C INSTRING: Name of file to be deletedC OUTSTRING: EmptyC!C IDISP = 5 : Evaluate DCL symbol.C INSTRING: Name of symbol to be evaluated C OUTSTRING: Value of symbolC+C IDISP = 6 : Compare two strings lexically:C INSTRING: Strings to be compared, separated by space?C OUTSTRING: One of the strings "-1", "0", or "1" as resultC5C IDISP = 7 : Compare two strings as a wildcard match:C INSTRING: Strings to be compared, separated by space9C OUTSTRING: One of the strings "0", or "1" as resultC--? INTEGER*4 FUNCTION TPU$CALLUSER(IDISP, INSTRING, OUTDESC)C INCLUDE '($SYSSRVNAM)' INCLUDE '($SSDEF)' INCLUDE '($LNMDEF)' INCLUDE '($LIBCLIDEF)'C8 INTEGER*4 STR$COPY_DX, STR$COMPARE, STR$MATCH_WILDCE INTEGER*4 ISTAT, IDISP, INLEN, IND, OUTLEN, OLDCTL, NEWCTL, LUN INTEGER*4 DESBLK(5) LOGICAL*4 EX INTEGER*2 FAOLEN CHARACTER*(*) INSTRING( CHARACTER*512 OUTSTRING, LOCSTRINGC EXTERNAL TPUEXTC5C Define itemlist and ouput descriptor structuresC STRUCTURE /ITMLST/ UNION MAP INTEGER*2 BUFLEN INTEGER*2 CODE INTEGER*4 BUFADR INTEGER*4 RETLENADR END MAP MAP INTEGER*4 ENDLIST END MAP END UNION END STRUCTUREC STRUCTURE /DYNAMIC/ INTEGER*2 LENGTH BYTE DTYPE BYTE CLASS INTEGER*4 ADDR END STRUCTUREC,C Declare itemlist and output descriptorC RECORD /ITMLST/ LNMLIST(2) RECORD /DYNAMIC/ OUTDESCC OUTLEN = 0C+C Big dispatchC-< GO TO (1000, 2000, 3000, 4000, 5000, 6000, 7000) IDISPC+C Disable Ctrl/TC-1000 NEWCTL = LIB$M_CLI_CTRLT+ CALL LIB$DISABLE_CTRL(NEWCTL, OLDCTL) DESBLK(2) = %LOC(TPUEXT) DESBLK(3) = 2 DESBLK(4) = %LOC(ISTAT) DESBLK(5) = %LOC(OLDCTL) CALL SYS$DCLEXH(DESBLK) GO TO 9000C+C Translate logical nameC-/2000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)C( LNMLIST(1).BUFLEN = LEN(OUTSTRING)# LNMLIST(1).CODE = LNM$_STRING) LNMLIST(1).BUFADR = %LOC(OUTSTRING)) LNMLIST(1).RETLENADR = %LOC(OUTLEN) LNMLIST(2).ENDLIST = 0CE ISTAT = SYS$TRNLNM(,'LNM$FILE_DEV',LOCSTRING(1:INLEN),,LNMLIST)! IF (.NOT. ISTAT) OUTLEN = 0 GO TO 9000C+C Create logical nameC-/3000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)) IND = INDEX(LOCSTRING(1:INLEN),' ')C IF (IND .LE. 1) THEN/ ISTAT = LIB$DELETE_LOGICAL(LOCSTRING(1:INLEN)) ELSE< ISTAT = LIB$SET_LOGICAL(LOCSTRING(1:IND-1),LOCSTRING(IND+1: * INLEN)) ENDIF GO TO 9000C+C Delete fileC-/4000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)1 ISTAT = LIB$DELETE_FILE(LOCSTRING(1:INLEN)) GO TO 9000C+C Evaluate DCL symbolC-/5000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)C ISTAT = LIB$GET_SYMBOL(LOCSTRING(1:INLEN), OUTSTRING, OUTLEN)! IF (.NOT. ISTAT) OUTLEN = 0 GO TO 9000C+C Compare two stringsC-/6000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)) IND = INDEX(LOCSTRING(1:INLEN),' ')CD ISTAT = STR$COMPARE(LOCSTRING(1:IND-1),LOCSTRING(IND+1:INLEN))9 CALL SYS$FAO('!SW', FAOLEN, OUTSTRING, %VAL(ISTAT)) OUTLEN = FAOLEN GO TO 9000C+FC Match two strings as candidate string and corresponding wildcardC-/7000 CALL STR$TRIM(LOCSTRING, INSTRING, INLEN)) IND = INDEX(LOCSTRING(1:INLEN),' ')CG ISTAT = STR$MATCH_WILD(LOCSTRING(1:IND-1),LOCSTRING(IND+1:INLEN))9 CALL SYS$FAO('!SW', FAOLEN, OUTSTRING, %VAL(ISTAT)) OUTLEN = FAOLENC+$C Return (possibly emtpy) stringC-79000 ISTAT = STR$COPY_DX(OUTDESC, OUTSTRING(1:OUTLEN)) TPU$CALLUSER = ISTAT RETURN END-C ***************************************-C * *-C * INTEGER*4 FUNCTION T P U E X T *-C * *-C ***************************************C++BC Exit Handler for the VTEDIT interface to TPU; re-establishes<C control characters switched off during initialization.CC Parameters:C3C ISTAT: Exit-Value for the image (VMS status code)8C MASK: Mask for the control characters to be re-enabledC--+ INTEGER*4 FUNCTION TPUEXT(ISTAT,MASK)C INTEGER*4 ISTAT,MASKC CALL LIB$ENABLE_CTRL(MASK) CALL SYS$EXIT(%VAL(ISTAT))C RETURNC END&*[WECK.VTEDIT.KIT.V51.B]VTEBUILD.TPU;76+,./ 4N-)0123KPWO56br7V89GHJ ! Compile VTEDIT from TPU or LSEprocedure vte$build_section:local temp_range, ! Range spanning the result of a search? compile_result, ! Result of compilation of trailing code8 key_to_delete, ! LSE key definition being deletedD key_map_to_clear, ! LSE key maps containing these definitionsH key_map_list_to_clear, ! LSE key map lists s containing these maps5 symbol_characters, ! Anything allowed in a name8 pat_name_end, ! Pattern for end of procedure name/ pat_begin, ! Pattern for procedure start, pat_end, ! Pattern for procedure end, pat_end_mod, ! Pattern for module end0 pat_def, ! Pattern for definition module4 pat_lse, ! Pattern for LSE definition module7 pat_lse_proc, ! Pattern for LSE procedure module? pat_lse_keys, ! Pattern for LSE key definition procedure* pat_break, ! Pattern for page break8 proc_name, ! Name of procedure currently compiled7 pos, spos, epos, vpos; ! Several useful positionson_error$ if error = tpu$_strnotfound then temp_range := 0; else! if error = tpu$_compilefail then quit; else message(error_text); endif; endif; endon_error;set(message_flags, 1);1if get_info(system, "facility_name") = "LSE" then vte$x_lse_support := 1; set(timer, off, ""); pos := mark(none); delete(message_window);0 message_window := create_window(1, 24, off);( map(message_window, message_buffer);* message("Clearing unneeded key maps");7 ! Remove LSE key definitions in order to save space= key_map_list_to_clear := get_info(key_map_list, "first"); loop" exitif key_map_list_to_clear = 0;G key_map_to_clear := get_info(key_map, "first", key_map_list_to_clear); loop! exitif key_map_to_clear = 0;7 if substr(key_map_to_clear, 1, 6) <> "EVE$$$" then1 key_to_delete := get_info(defined_key, "first", key_map_to_clear);  loop exitif key_to_delete = 0;4 undee VTEDIT051.B)&[WECK.VTEDIT.KIT.V51.B]VTEBUILD.TPU;76Nnfine_key(key_to_delete, key_map_to_clear);4 key_to_delete := get_info(defined_key, "next", key_map_to_clear); endloop; endif;2 key_map_to_clear := get_info(key_map, "next", key_map_list_to_clear); endloop;9 key_map_list_to_clear := get_info(key_map_list, "next"); endloop;$ message("Starting compilation"); position(pos);else vte$x_lse_support := 0;* main_buffer := create_buffer("$MAIN"); position(main_buffer);3 read_file(get_info(command_line, "file_name"));endif;L! Set global variables such that the compiler won't take them for proceduresinfo_window := 0;message_window := 0;help_buffer := 0;message_buffer := 0;show_buffer := 0;set(no_write, current_buffer);&pat_begin := line_begin & "procedure";'pat_end := line_begin & "endprocedure";(pat_end_mod := line_begin & "endmodule";8pat_def := line_begin & "module vte$global_definitions";5pat_lse := line_begin & "module vte$lse_definitions";9pat_lse_proc := line_begin & "module vte$lse_procedures";6pat_lse_keys := line_begin & "procedure vte$lse_keys";pat_break := page_break;Msymbol_characters := "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" +N "0123456789$_";(pat_name_end := span(symbol_characters);set(success, off);!position(end_of(current_buffer));1temp_range := search(pat_def, reverse, no_exact);position(temp_range);"move_horizontal(- current_offset);pos := mark(none);move_vertical(1);.position(search(pat_end_mod, forward, exact));;move_horizontal(length(current_line) - current_offset + 1);7message("Executing constant and variable definitions");?compile_result := compile(create_range(pos, mark(none), none));if compile_result <> 0 then execute(compile_result);endif;!position(end_of(current_buffer));1temp_range := search(pat_lse, reverse, no_exact);position(temp_range);"move_horizontal(- current_offset);pos := mark(none);move_vertical(1);.position(search(pat_end_mod, forward, exact));;move_horizontal(length(current_line) - current_offset + 1);if vte$x_lse_support then? message("Executing LSE constant and variable definitions");C compile_result := compile(create_range(pos, mark(none), none)); if compile_result <> 0 then execute(compile_result); endif;else. erase(create_range(pos, mark(none), none))endif;if not vte$x_lse_support then+ position(beginning_of(current_buffer));: temp_range := search(pat_lse_proc, forward, no_exact); if temp_range <> 0 then position(temp_range);# move_horizontal(- current_offset); pos := mark(none);6 temp_range := search(pat_end_mod, forward, no_exact); if temp_range <> 0 then position(temp_range);@ move_horizontal(length(current_line) - current_offset + 1);0 erase(create_range(pos, mark(none), none)); endif; endif;: temp_range := search(pat_lse_keys, forward, no_exact); if temp_range <> 0 then position(temp_range);# move_horizontal(- current_offset); pos := mark(none);2 temp_range := search(pat_end, forward, no_exact); if temp_range <> 0 then position(temp_range);@ move_horizontal(length(current_line) - current_offset + 1);0 erase(create_range(pos, mark(none), none)); endif; endif;endif;'position(beginning_of(current_buffer));pos := mark(none);loop7 temp_range := search(pat_begin, forward, no_exact); exitif(temp_range = 0);% spos := beginning_of(temp_range); position(spos);% move_horizontal(-current_offset);3 temp_range := search("vte", forward, no_exact);% vpos := beginning_of(temp_range); position(vpos);7 temp_range := search(pat_name_end, forward, exact);M proc_name := substr(create_range(vpos, end_of(temp_range), none), 1, 80);- message(fao("Compiling !AS", proc_name));2 temp_range := search(pat_end, forward, exact); exitif(temp_range = 0);% epos := beginning_of(temp_range); position(epos); move_vertical(1); pos := mark(none); move_horizontal(-1);2 compile(create_range(spos, mark(none), none));endloop;position(pos);set(informational, off);5compile("procedure vte$build_section endprocedure;");set(informational, on);set(success, on);set(line_number, off);!position(end_of(current_buffer));,position(search(pat_break, reverse, exact));pos := mark(none);Kcompile_result := compile(create_range(pos, end_of(current_buffer), none));if compile_result <> 0 then' message("Executing trailing code"); execute(compile_result);endif; endprocedure;!vte$build_section;quit;#*[WECK.VTEDIT.KIT.V51.B]VTEDIT.CLD;4+,./ 41-)0123KPWO56  d7ur89GHJdefine verb VTEDIT image TPU1 parameter P1 , label=FILE_NAME , prompt="File" value (type=$infile) qualifier COMMAND default value (type=$infile) qualifier DEBUG. value (default="TPU$DEBUG",type=$infile) qualifier DISPLAY default value (type=$infile) qualifier SECTION nonnegatable default0 value (default="VTE_SECTION",type=$infile) qualifier CREATE default qualifier INITIALIZATION default value (type=$infile) qualifier JOURNAL default value (type=$outfile) qualifier MODIFY qualifier OUTPUT value (type=$outfile) qualifier READ_ONLY qualifier RECOVER qualifier START_POSITION nonnegatable( value (required,list,type=$number) qualifier WRITE' disallow (RECOVER and (neg JOURNAL))! disallow (READ_ONLY and WRITE)- disallow ((neg READ_ONLY) and (neg WRITE))$*[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30+,7.l/ 4ulk-)0123KPWOm56o蜒7`X89GHJ VTEDITu Keypad Text Editor and Corrector for VAXTPU Mini Reference: Software Version: VTEDIT V5.1 (for VAXTPU V2.2 and VAX LSE V2.3) August 1989 2' The VTEDIT CommandM The VTEDIT command invokes the TPU editor using the VTEDIT interface. TheM VAX Text Processing Utility (VAXTPU) is a high performance, extensibleM utility that provides several editing interfaces. The VTEDIT interface isM an efficient, keypad driven editor allowing multi window editing and? providing semi-automatic, context dependent text formatting. Format:! $ VTEDIT [file-spec] Command Qualifiers:> /COMMAND /CREATE /CURRENT_FILE /DISPLAYL /ENVIRONMENT /INITIALIZATION /JOURNAL /LANGUAGE /LSEL /MODIF?2 VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30ulY /OUTPUT /READ_ONLY /RECOVER /START_POSITION% /SYSTEM_ENVIRONMENT /WRITE# General InformationM VAXTPU is a text processing utility available with the VMS operatingM system. High performance and extensibility are two of the major featuresM of VAXTPU. The screen oriented text processing features of VAXTPU areM targeted to the VT200 and VT100 families of terminals, but they can beM used on other ANSI CRTs. VAXTPU can also be used to do batch mode text processing.M The utility consists of a procedural language, a compiler, anM interpreter, and several editing interfaces of which VTEDIT is one. TheM interfaces are written in the VAXTPU language and they are layered onM VAXTPU. You can use VTEDIT or one of the other interfaces to performM editing tasks, and you can use them to access VAXTPU features that allow< you to customize or extend the interface you are using.M After you are familiar with VTEDIT and the functions it provides, useH the VAX Text Processing Reference Manual for information on VAXTPU.M Once you have invoked VAXTPU with the VTEDIT editing interface, you canM get on-line help about both the interface and VAXTPU from within the VTEDIT interface. Parameters file-specM Specifies the file to be created or edited using the VTEDIT editingM interface. If the file you specify does not exist, the VTEDITM interface provides a buffer in which to create the file. If you writeM out the contents of the buffer VAXTPU will create the file in the appropriate directory.M If you do not provide a file specification as a parameter when youM invoke VAXTPU, the VTEDIT interface will try to find out which file wasM edited last, and re-edit that file. If VTEDIT's memory is empty, VTEDITM will create an empty buffer named '$Main' having no output file name associated with it.M VAXTPU does not provide a default file type when creating files; if youM do not include a file type, it is null. The file must be a disk file% on a Files-11 formatted volume.P 3M You may use wildcards to specify the file to be edited. If there isM exactly one file matching the given wildcard, this file is edited. IfM there are several files matching, VTEDIT displays a list of their namesM and lets you select one of the files from this list. (This feature isN not fully available if VTEDIT is invoked with LSE support; in this case,M the first file matching the wildcard is selected always, even if there" are several files matching.)" Command Qualifiers' /COMMAND[=command-file] (D) /NOCOMMANDM Determines whether VTEDIT reads a user-written VAXTPU source file forM initialization purposes. The default file type for command files isM TPU. By default, VTEDIT tries to read a file called VTE$COMMAND.TPUM from your default directory. You can use a file specification after theM /COMMAND qualifier or define the logical name VTE$COMMAND to point to a. command file other than the default one.M If VTEDIT is invoked with LSE support, the logical name LSE$COMMAND isM an alternative to the /COMMAND command qualifier. If /COMMAND orM /NOCOMMAND does not appear on the command line, VTEDIT attempts toM translate the logical name LSE$COMMAND. If it has a translation, thatD value is used in the same way as the /COMMAND qualifier value.M To prevent VAXTPU from processing a command file, use the /NOCOMMANDM qualifier. When you are not using a command file, specifyingM /NOCOMMAND decreases startup time by eliminating the search for a command file. /CREATE (D) /NOCREATEM Controls whether VAXTPU creates a new file when the specified inputM file is not found. The VTEDIT interface is responsible for processingM this qualifier. By default, the VTEDIT interface provides a buffer inM which to create the file. If you write out the contents of the bufferM (either explicitly or by exiting from the editor), VAXTPU will create aM new file for the input file specification. When you use the /NOCREATEM qualifier and enter a file specification that does not exist, VTEDIT6 returns you to the DCL command level as follows:# $ VTEDIT/NOCREATE NEWFILE.DATM (VTEDIT clears the screen and displays a message similar to the following:)9 Input file does not exist: DISK$:[USER]NEWFILE.DAT; $ /CURRENT_FILE (D) /NOCURRENT_FILEM If no input file is specified on the command line, /CURRENT_FILEM specifies that the name and type of the file that was edited last beM used as the input file. If an incomplete file specification isM specified on the command line (that is, only a file name or a fileM type), /CURRENT_FILE specifies that the name or the type of theM previously edited file be used to complete the file specification. IfM /NOCURRENT_FILE is specified, VTEDIT will not use its memory to resolve@ an input file specification. /CURRENT_FILE is the default. 4M This qualifier is only valid if VTEDIT has been installed with LSEM support and if the qualifier /NOLSE is not present on the command line.+ /DISPLAY[=display-filespec] (D) /NODISPLAYM Determines whether the editing session is being run on a supportedM terminal and is using terminal functions, such as the screen display and keyboard.M By default, sessions are run with a screen management file calledM TPU$CCTSHR.EXE, for ANSI terminals. If VTEDIT is used with LSE support,M the default screen management file is LSE$CCTSHR.EXE. For moreM information about VAXTPU-supported terminals, see the VAX Text Processing Utility Manual.M Use /NODISPLAY when you want to run VTEDIT in batch mode, or when youM are using an unsupported terminal -- that is, without using the screen% display and keyboard functions.M The qualifier /NODISPLAY is not supported if VTEDIT is invoked with LSEM support; this qualifier must be combined with the qualifier /NOLSE if1 VTEDIT has been installed with LSE support.' /ENVIRONMENT=file-spec-list /NOENVIRONMENT (D)M Specifies the name of one or more binary environment files containingM Editor language, token, placeholder, or alias definitions. The Editor; reads in these definitions as part of Editor startup.M The file-spec-list is either a single file-spec or a list of file-specs6 separated by commas and enclosed in parentheses.M If definitions or deletions of items appear in more than one file, theI definition that appeared in the first listed file takes precedence.K SYS$LIBRARY is the default device, and the default file type is .ENV.M The logical name LSE$ENVIRONMENT is an alternative to the /ENVIRONMENTM 9a VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30ultqualifier. If /ENVIRONMENT or /NOENVIRONMENT is not used, the EditorM will attempt to translate the logical name LSE$ENVIRONMENT. If theM logical name has translations, the values are used in the same way asM the /ENVIRONMENT qualifier values. The Editor translates the first ten2 indices of the logical name LSE$ENVIRONMENT.M This qualifier is only valid if VTEDIT has been installed with LSEM support and if the qualifier /NOLSE is not present on the command line.% /INITIALIZATION=file-spec! /NOINITIALIZATION (D)M Determines whether VTEDIT reads a user-written initialization fileM containing a sequence of VTEDIT commands to be executed as part ofM Editor startup. The default file type for initialization files is VTE.M By default, VTEDIT tries to read a file called VTE$INIT.VTE from yourM default directory. You can use a file specification after theM /INITIALIZATION qualifier or define the logical name VTE$INIT to point: to a initialization file other than the default one.P 5 M If VTEDIT is invoked with LSE support, the startup commands that VTEDITM expects are LSE commands and not VTEDIT commands. Also, the logicalM name LSE$INITIALIZATION is an alternative to the /INITIALIZATIONM qualifier. If /INITIALIZATION or /NOINITIALIZATION is not used, theM Editor will attempt to translate the logical name LSE$INITIALIZATION.M If the logical name has a translation, that value is used in the same1 way as the /INITIALIZATION qualifier value.' /JOURNAL[=journal-file] (D) /NOJOURNALM Determines whether VAXTPU keeps a journal file of your editing sessionM so that you can recover from an interrupted session. The VTEDITM interface is responsible for processing this qualifier. By default,M the VTEDIT interface maintains a journal file that has the same name asM the input file and a file type of TJL. If you invoke VAXTPU without aM file specification, the default name for the journal file is TPU.TJL.M Use a full file specification with the /JOURNAL qualifier to specify a* different name for the journal file.M If you are editing a file from another directory and want the journalM file to be located in that directory, you must use the /JOURNALM qualifier with a file specification that includes the directory name.J Otherwise, VAXTPU creates the journal file in the default directory.M To prevent VAXTPU from keeping a journal file for your editing session,# use the /NOJOURNAL qualifier.M See the /RECOVER qualifier for information on how to have VAXTPU7 process the commands contained in a journal file. /LANGUAGE=languageM Sets the language for the current input file, overriding the language. indicated by the input file's file type.M This qualifier is only valid if VTEDIT has been installed with LSEM support and if the qualifier /NOLSE is not present on the command line. /LSE /NOLSEM Controls whether VTEDIT loads the Language-Sensitive Editor VAX LSE orM not. The Language-Sensitive Editor is a multi-language advanced textM editor specifically designed for software development, available as aM layered product for VMS. If VTEDIT is installed with LSE support, LSEM will be loaded together with VTEDIT, unless this is explicitly3 inhibited by specifying the /NOLSE qualifier. H Use of this Qualifier requires presence of VAX LSE on your system. /MODIFY /NOMODIFYM Specifies whether the buffer created for the input file is modifiableM or unmodifiable. If you specify the /MODIFY qualifier, the VTEDITM command creates a modifiable buffer. If you specify the /NOMODIFYM qualifier, the VTEDIT command creates an unmodifiable buffer. If you doM not specify either qualifier, VTEDIT determines the buffer's modifiableM status from the read-only/write setting. By default, a read-only buffer7 is unmodifiable and a write buffer is modifiable. 6# /OUTPUT=output-file (D) /NOOUTPUTM Determines whether VAXTPU creates an output file at the end of yourM editing session. The VTEDIT interface is responsible for processingM this qualifier. By default, the VTEDIT interface uses the same fileM specification for both the input file and the output file. The outputM file has a version number one higher than the highest existing versionM of the input file. Use a file specification with the /OUTPUT qualifierM to specify a file name that is different from the input file. You canM include directory information as part of your output file specification* to send output to another directory.M The /NOOUTPUT qualifier suppresses the creation of an output file forM the main buffer, but not the creation of a journal file. If you invokeM VAXTPU with /NOOUTPUT and then decide you want an output file, use oneM of the output commands in the VTEDIT interface before you end theD editing session to write out the contents of the main buffer.  /READ_ONLY /NOREAD_ONLY (D)M Determines whether VAXTPU keeps a journal file and creates output filesM from the contents of the main buffer and from any other user buffers.M With the default /NOREAD_ONLY, VAXTPU maintains a journal file andM creates output file from the contents of any buffers that you modified.M Using the /READ_ONLY qualifier is like using the /NOJOURNAL qualifierM for the editing session and the /NOOUTPUT qualifier for all buffers.M When you specify /READ_ONLY, VAXTPU does not maintain a journal fileM for your editing session, and the NO_WRITE attribute is set for allM user buffers. When a buffer is set to NO_WRITE, the contents of theM buffer will not be written out when you leave VTEDIT. Both the EXIT andM QUIT built-in procedures will end the editing session without creatingM a new file from the contents of the user buffers (even if you modified them). M Use /READ_ONLY when you are searching a file. If you change your mindM and want to save any edits you make to the file, use the Write Text toM Output File command to write the currently selected range to anL external file. Remember, however, that you do not have a journal file. /RECOVER /NORECOVER (D)M Determines whether VAXTPU reads a journal file at the start of an2 editing session. The default is /NORECOVER.M When you use the /RECOVER qualifier, VAXTPU reads the appropriateM journal file and processes whatever commands it contains. If theM journal file type is not TJL or if the file name is not the same as theM input file name, you must include both the /JOURNAL=journal-file+ qualifier and the /RECOVER qualifier.M When you are recovering a session, all files must be in the same stateM as they were at the start ofH[s VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;3076ul4+! the editing session being recovered. All M terminal characteristics must also be in the same state as they were atM the start of the editing session being recovered. Check especially theM) following terminal characteristics:eP 7 1. Device_Type9 2. Edit_mode[ 3. Eightbit 4. Page 5. WidthnM Furthermore, all initialization and environment files used in the 9 original run must be used in the recovery run, too.i) /START_POSITION=(Line,Column).% /START_POSITION=(1,1) (D)cM Specifies the starting line and column in the file. If a filesM specification is not specified, the last specification invoked by the M editor is used. The cursor is positioned at the place corresponding to M the cursor's location at the time the last editor-invoked file was left. ) /SYSTEM_ENVIRONMENT=file-spec % /NOSYSTEM_ENVIRONMENT (D)_6 /SYSTEM_ENVIRONMENT=LSE$SYSTEM_ENVIRONMENTM Specifies the name of a system environment file. The difference betweenaM files specified by this qualifier and those specified by a /ENVIRONMENTlM qualifier is: Definitions derived from this qualifier cannot be savedo$ by a SAVE ENVIRONMENT command.M This qualifier is only valid if VTEDIT has been installed with LSE M support and if the qualifier /NOLSE is not present on the command line.  /WRITE (D) /NOWRITEM Specifies that the file on the VTEDIT command line be put into aiM writeable modifiable buffer. The /NOWRITE qualifier specifies that theeM file on the VTEDIT command line be put into a read_only unmodifiableI buffer.  MemoryrM VTEDIT automatically remembers the file being edited. If you invokeM VTEDIT without specifying a file-spec, VTEDIT will read its memory ando# re-edit the last edited file. fM VTEDIT's memory is controlled by the logical name TPU$MEMORY. If theoM logical name TPU$MEMORY translates to a string of the form $filespec, M VTEDIT uses the specified file for its memory. Otherwise, VTEDIT usesXM the logical name itself as the memory. On exiting, the edited file's M name is stored in a process logical name called TPU$MEMORY, or, if thistM name translates to a string of the form $filespec, the edited file's * name is stored in the specified file.M For compatibility with previous, TECO-based releases of VTEDIT, thesM logical name TEC$MEMORY is used instead of TPU$MEMORY, if TPU$MEMORYt) translates to the string TEC$MEMORY.sM If the Language-Sensitive Editor is installed and has set its own filefM memory, VTEDIT uses this memory instead of its own memory. In thisi5 case, VTEDIT updates both memories upon exiting.r 8 Examples7 1. $ VTEDIT/OUTPUT=NEWFILE.TXT OLDFILE.TXT M This VTEDIT command invokes VAXTPU to edit the file OLDFILE.TXT using M the section file SYS$LIBRARY:VTE_SECTION.TPU$SECTION that creates thefM VTEDIT editing interface. VAXTPU then tries to read the command file M VTE$COMMAND.TPU in your default directory. If you have not defined theoM logical name VTE$COMMAND to point to a user-written command file, andhM if you do not have a file named VTE$COMMAND.TPU in your default M directory, VAXTPU does not read a command file. If you modify the mainnM buffer and use the Exit command to end the session, the edited file hasV the name NEWFILE.TXT.p$ 2. $ VTEDIT OLDFILE.TXTM This VTEDIT command invokes VAXTPU with the VTEDIT editing interface.eM VAXTPU makes a copy of the file OLDFILE.TXT available for editing. WhendM you leave the editing session, VAXTPU creates a new version of the filedM with a version number one higher than the highest existing versionf number for that file. M If the Language-Sensitive Editor is present and if VTEDIT has beenMM installed with LSE support, VTEDIT invokes the Language-Sensitivef6 Editor, providing an enhanced command interface., 3. $ VTEDIT/RECOVER OLDFILE.TXTM This VTEDIT command invokes VAXTPU with the VTEDIT editing interface toeM recover from an abnormal exit during a previous editing session. VAXTPUnM opens the file OLDFILE.TXT, and then processes the journal filedM OLDFILE.TJL. Once the journal file has been processed, you can resume  interactive editing.* 4. $ VTEDIT/NOLSE OLDFILE.TXTM This command suppresses the automatic loading of the Language-SensitivefM Editor VAX LSE, if VTEDIT has been installed with LSE support, andmM instead uses a version of VTEDIT that is identical to VTEDIT on systemsnM without VAX LSE. VTEDIT makes a copy of the file OLDFILE.TXT available M for editing. When you leave the editing session, VAXTPU creates a newhM version of the file with a version number one higher than the highests, existing version number for that file.? 5. $ VTEDIT/LSE/ENVIRONMENT=LOCAL/LANGUAGE=FORTRANtM This command, which requires presence of the Language-Sensitive EditorxM VAX LSE, invokes VTEDIT with the LSE enhanced editing interface. VTEDIT M opens the file that was edited using LSE with VTEDIT or native LSE, M whichever occured most recently, and makes language support for theoM Fortran language available for editing. VTEDIT uses a local environment: definition stored in the file SYS$LIBRARY:LOCAL.ENV.P 9 Command Entry$ Notational ConventionsB All (*) commands take an optional numeric argument as:" [-] W All (#) commands must use a numeric argument, i.e. their argument is  mandatory, not optional. H All (`) commands operate on selected ranges, if Select is active.M All (a) commands operate on rectangular regions, if Select Rectangulari is active.nQ All commands in the lower parts of the fields are prefixed by , P displayed as  in the following command list. The effect of pressingI the key by mistake can be cancelled by typing the Ctrl/U key; J the key sequence Ctrl/U rings the terminal bell, but otherwise0 acts as a command without any consequences.K The keypad and function keys are enclosed in quotation marks ("); keysfG shown without quotation marks are ordinary typing keys on the maine keyboard.G Commands that are new in version V5 are marked with in the righttH margin, and changed and enhanced commands are marked with |.! Numeric Arguments KFormat:  numeric expression (i.e.,  arg1 [op arg2]) & Numeric Expression Operators + Addition - Subtraction#* Multiplication / Divisionn= Evaluate current arg1 op arg2t^- Change sign of current arg2" Radix Change Commands=^D decimal (base 10) ^O octal (base 8) ^X hex (base 16)o "arg2" Stand-ins!^- The inverse (negative) of arg2i^. Current line nu| VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30ul0mber3^Z Current total number of lines in the text buffer C^L The distance to the end of the current line if arg2 is positive,+ otherwise to the start of the current lined)^N The result of the last Count operationD*^^x The value of character xB^Qq The contents of the numeric part of Q-register q>^A The value of the character at distance 'arg2' to the cursorD^\ The value of the number in the text buffer, immediately following' the cursor, or 0 if there is no numbere8^Ctrl/\ The same, but deleting this number from the text 10h Keypad Layout! VT100 Cursor KeysI lqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqknQ x "O|" x "O~" x "O{" x "O}" xpQ x Up in Column *xDown in Column*x Cursor Left * x Cursor Right* xuI x q q q q q q q x q q q q q q q x q q q q q q q x q q q q q q q xEQ x Up Screen * x Down Screen * x Shift Left * x Shift Right * xNI mqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqjn Numeric KeypadOI lqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqwqqqqqqqqqqqqqqqkiI x "PF1" x "PF2" x "PF3" x "PF4" xnO x x Save Text *`a x Paste Text *a xSearch/Repl. *`x R x G o l d x q q q q q q q x q q q q q q q x q q q q q q q xX x () x Write Text *` xRead this File x Replace All ` xI tqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqunI x "7" x "8" x "9" x "q" xtQ x Open Line * x Next Page * xSelect / Quote*xInsert/Overstr*xsI x q q q q q q q x q q q q q q q x q q q q q q q x q q q q q q q x Q xDirectory List.xOutput & Close xSelect Rectang.xRead Lowercase*x I tqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqquII x "4" x "5" x "6" x "," x Q x Up Line * x Delete Char * x Delete/Restorex Replace Found x I x q q q q q q q x q q q q q q q x q q q q q q q x q q q q q q q x Q xUp Continuouslyx Formatter x Skip xSet/Delete MarkxSI tqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqu$I x "1" x "2" x "3" x "ENTER" xfO x Top / Jump *`ax Bottom x Start of Line x x K x q q q q q q q x q q q q q q q x q q q q q q q x Enter xeQ xOpen Input FilexOpen Outp File x Open Buffer x Search Argum* xeI tqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqnqqqqqqqqqqqqqqqu q q q q q q q x[K x "0" x "." x Enter x O x Down Line* x Search Again* x Replace Argum xrI x q q q q q q q q q q q q q q q x q q q q q q q x x M x Down Continuously x Go to Mark x xlI mqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqvqqqqqqqqqqqqqqqjJP 11" VT200 Function KeysM Commands shown in bold are only available if VTEDIT is installed I with LSE support and if it is not invoked with the qualifier /NOLSE.lL lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqkL x "F6" x "F7" x "F8" x "F9" x "F10" xV x Cancel x Next Buffer xOther Window*xChange Wind.*x Exit xL x q q q q q q x q q q q q q x q q q q q q x q q q q q q x q q q q q q x` x x List BuffersxGoto Declar*`xFind Symbol*`x xL mqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqj> lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqk> x "F11" x "F12" x "F13" x "F14" xM xCompile TPU*`x End of Line x Expand x Page Back * x > x q q q q q q x q q q q q q x q q q q q q x q q q q q q xT xExecute TPU*`x Show Status x LSE Keys * x Review x> mqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqj> lqqqqqqqqqqqqqwqqqqqqqqqqqqqqqqqqqqqqqqqqqkB x "Help" x "Do" xI x Get Help x VTEDIT / LSE Command * xa> x q q q q q q x q q q q q q q q q q q q q xB x Show Status x TPU Command x> mqqqqqqqqqqqqqvqqqqqqqqqqqqqqqqqqqqqqqqqqqj> lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqkD x "Find" x"Insert Here"x "Remove" xD xSearch Argum*xReplace Argumx Delete *`a x> x q q q q q q x q q q q q q x q q q q q q xD x Go to Mark x Insert Mark x Remove Mark x> tqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqquD x "Select" x"Prev Screen"x"Next Screen"xD x Select xBack Screen* xAdvance Scr.*x> x q q q q q q x q q q q q q x q q q q q q xR xSel. Rectang.xPrevPlacehld*xNextPlacehld*x> mqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqj2 x "O|" x2 xUp in Column*x0 x q q q q q q x1 x Up Screen * x,> lqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqkD x "O{" x "O~" x "O}" xD xCursor Left *xDown in Col.*xCursor Right*x> x q q q q q q x q q q q q q x q q q q q q xD xShift Left * xDown Screen *xShift Right *x> mqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqj> lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqk> x "F17" x "F18" x "F19" x "F20" xF x Attach x DCL Command x Spawn x Compile x> x q q q q q q x q q q q q q x q q q q q q x q q q q q q xb xErasePlacehldx Goto Source xPrev. Error *x Next Error *x> mqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqj 12w* VTEDIT Control Commands Moving the Cursor(Jump to Top/Line n/Selection *`a "1" Jump to End of Buffer "2"Advance Line * "0"Back Line * "4"tStart of Line "3"o0End of Line "Backsp." or "F12" or Ctrl/HAdvance Character * "O}"Back Character * "O{"Down in Column * "O~"Up in Column * "O|"Advance Word * Ctrl/FsBack Word * Ctrl/R'Advance Continuously "0"e$Back Continuously "4":Advance Screen Image * "O~" or "Next Screen"7Back Screen Image * "O|" or "Prev Screen" Advance Page * "8".Back Page * "F14" (or "8" with arg. < 0),Skip Over Last Operation "6"AFind Remembered Position from Previous Run -Fo+ Marking and Retrieving Positionse'Start Selection "9" or "Select"wHSelect Corner of Rectangular Region "9" or "Select"$Jump to Start of Selection "{ VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30ul?1"AInsert Permanent Mark "," or "Insert Here"r<Remove Permanent Mark "," or "Remove".Insert/Remove Permanent Mark ","6Go to (next) Mark "." or "Find" PromptingMTerminate Prompts via the keypad key "." or, on VT200 terminals, via the "Do"lMkey. Prompts for VTEDIT commands or file and buffer names are also terminatedw(by "Return". Reject Prompting by Ctrl/Z. Searching Text@Set Search Argument and Search Text Buffer * "Enter" or "Find"Search Again * "."+Search and Count Occurrences *` Ctrl/Ni' Match Control CharactersoJSearch strings may contain match control characters and/or string buildingFcharacters allowing the specification of more general search criteria: ^M newline ^X any character ^S any non-alphanumericq+ ^N x any character except xa/ ^E n x n occurences of x  ^E A any letter A...Z a...zf ^E B any non-alphanumericc) ^E C any symbol constituent A...Z $ . _i ^E D any digit 0...9G ^E E x exactly the character x (without interpretation)r4 ^E G q any character in Q-register q) ^E L any line terminator P 13( ^E M x any sequence of x. ^E N any supplemental (multinational) letter3 ^E P any TPU pattern (delimited by a second ^E P)l3 ^E Q q the contents of Q-register qt) ^E R any alphanumeric A...Z a...z 0...9O' ^E S any sequence of blanks and _! ^E T any sequence of characterscH ^E U q the ASCII character whose code is in Q-register q! ^E V any lowercase letter a...z ! ^E W any uppercase letter A...Zh ^E X any characterL ^E [x...y] anyone of the characters from x to y Controlling Searchess2Toggle Case-Sensitivity of Searches G8Set Search to be Case-Sensitive -G9Set Search to be Case-Insensitive 0GI;Toggle Resulting Position on Failing Searches Kt=Preserve Position on Failing Searches 0Ku8Jump to Top on Failing Searches -K Replacing TextPSet Replacement Argument and Replace String "Enter" or "Insert Here" just Searchedi&Replace String just Searched ","'Search and Replace String *` "PF4"qBSearch and Replace all Occurrences of a String ` "PF4") String Building Constructsc>The following constructs may be used in replacement arguments: ^M newlineG ^E E x exactly the character x (without interpretation) 3 ^E Q q the contents of Q-register q_J ^E n the string found for the n-th match control construct( Inserting and Moving TextInsert Space * "Space""Insert Tab "Tab" or Ctrl/I)Insert Newline * "Return" or Ctrl/M-Open Line * "7"l:Get Contents of Q-register q * a Ctrl/Gq3Save to Q-register q *`a Ctrl/PqE>Save and Append to Q-register q *`a Ctrl/P:q2Cut to Q-register q *`a Ctrl/Tq=Cut and Append to Q-register q *`a Ctrl/T:qySave Text *`a "PF2"lPaste Text * a "PF3"<Insert next Character x Ctrl/\x<Insert ASCII Value of Character x Ctrl/\x<Insert Numeric Value of Argument n # Ctrl/\)Insert Special Character # "9"aInsert Page Break Ctrl/L?Insert Umlaut (||||||) " and a|o|u|A|O|U|sfInsert Date Ctrl/]"Insert Time Ctrl/]*Insert Input File Name -"1"+Insert Output File Name -"2" -Insert Current Buffer Name -"3" <Insert Next File Name according to Wildcard -"7" 14i Formatter Control:Toggle (enable/disable) Formatter Activation E+Disable Formatter 0E *Enable Formatter -E=Select Formatter Type via specified File Type "5" 4Toggle Parenthesis Highlighting Ctrl/F=Enable Parenthesis Highlighting -Ctrl/Fe=Disable Parenthesis Highlighting 0Ctrl/Fn:Toggle Automatic Parenthesis Insertion Ctrl/RCEnable Automatic Parenthesis Insertion -Ctrl/RoDDisable Automatic Parenthesis Insertion 0Ctrl/RH Formatter Control Characters (Active only at Start of Line)'Reset Indentation to Base Value =N%Indent to Current Indentation .LIncrease Indentation *` >TDecrease Indentation *` < 'Indent Fortran Continuation Line *m"Indent Query Language by 3 +"Indent Query Language by 2 -, Controlling Text Insertion Modes'Toggle Insert/Overstrike Mode "-"i&Enable Insert Mode -"-"*Enable Overstrike Mode 0"-"/Toggle Lowercase Reading Mode "-"o@Enable Reading of Lowercase Characters -"-">Convert Lowercase Input to Uppercase 0"-">Toggle (enable/disable) Buffer Modification Ctrl/T7Allow Buffer Modification -Ctrl/Tn6Set Buffer Unmodifiable 0Ctrl/T Converting Casei'Convert to Lowercase *` Vn'Convert to Uppercase *` WnChange Case *` Zf#Capitalize Word *` Qr Deleting Text )Rub Out Previous Character * "Delete" Delete Next Character * "5"#Rub Out Previous Word * Ctrl/Bs&Delete Next Word * Ctrl/B#Rub Out Start of Line Ctrl/Uf0Delete Line or Range *`a Ctrl/K or "Remove"!Delete Rest of Line Ctrl/Do!Delete or Restore Text "6"T7Kill Text Buffer (without Restore!) Ctrl/Do Exiting /Exit from VTEDIT Ctrl/Z or "F10" :Quit VTEDIT Without Preserving Output -Ctrl/Z=Exit from VTEDIT Remembering Position 0F P 15, Controlling Input and Output Files(Open (new) Input File "1"Append File Ctrl/A/Include File at Current Position At/Open (new) Buffer for Editing "3"h*Write (new) Output File "2"/Write Text to Output File *` "PF2"a*Output and Delete Buffer "8">Output Buffer and Compile Output 1Ctrl/Z or "F20"$Display Directory "7";Display List of all Buffers "F7" or : =Select File or Buffer from List or Wildcard "PF3"[4Toggle Read-Only/Read-Write Mode Ctrl/W:Set Current Buffer Read-Only 0Ctrl/W;Set Current Buffer Read-Write -Ctrl/W(- Controlling the Video TerminalmRepaint Screen Ctrl/W %Set Cursor Line # Ctrl/W(,Toggle Graphic-Tabs Display Mode Ctrl/V?Display Text Interpreting Control Sequences -Ctrl/Vr6Set Right Margin and Terminal Width # Ctrl/V!Set Left Margin * M 3Enter/Exit Screen Holding Mode * Ctrl/Vl(Use Free Cursor Movement >)Use Bound Cursor Movem v; VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;3076ulNent  Indent More < Indent LessF + Increase Indent - Decrease Indent! * Indent ContinuationqK A Include File " Umlaut V B Two Windows # Erase Placeholder[ C Other Window $ Set Do [LSEDIT/VTEDIT]hP D One Window ' Find SymbolY E Set Formatter [Off/On] ( Previous Placeholder U F Reset Journal ) Next Placeholder P G Set Search Case [Any/Exact] * Goto SourceK H Help + Repeat P I Attach , Execute TPUK J DCL - Repeat P K Set Search Origin [Cur/Top] . Compile TPUQ L Learn : List BuffersqU M Set Left Margin ; Goto DeclarationQ N Get Next Word < Bound Cursor K O Center Line = ReviewmP P Fill > Free CursorR Q Capitalize Word ? Language He  | VTEDIT051.B7)$[WECK.VTEDIT.KIT.V51.B]VTEDIT.DOC;30ul]lpR R Set Tabs [At/Every] [ Previous StepN S Spawn ] Next StepK T Set Word Delimiters ^ Repeatr! U Store Number , V Lowercase  W Uppercase$ X Execute Learned Y Menu Z Change Case# "PF1" Key "" I "PF2" Save "PF2" Write RangeeG "PF3" Paste "PF3" This FileeI "PF4" Replace "PF4" Replace AlltG "0" Next Line "0" Scroll UpnG "1" Top "1" Read FileH "2" Bottom "2" Write FileD "3" Start of Line "3" BufferI "4" Previous Line "4" Scroll DowneG "5" Erase Next Char "5" FormatterRH "6" Restore "6" Skip RangeI "7" Split Line "7" File SearchhH "8" Next Page "8" Close FileP "9" Mark "9" Select RectangularI "," Exchange "," Toggle MarknT "-" Set Mode [Insert/Overstr] "-" Set Case [Lower/Upper]G "." Find Next "." Find MarkH "Enter" Find "Enter" SubstituteM O~ Move Down O~ Next Screen L O{ Move Left O{ Shift LeftM O} Move Right O} Shift Right Q O| Move Up O| Previous ScreenuP 19G Find Find Find Find MarkeI Insert Here Substitute Insert Here Insert Mark I Remove Remove Remove Remove MarkmP Select Select Select Select RectangularR Prev Screen Previous Screen Prev Screen Previous PlaceholderN Next Screen Next Screen Next Screen Next PlaceholderB Help Help Help ShowA Do Do / LSE Command Do TPU J F7 Next Buffer F7 List BuffersN F8 Other Window F8 Goto DeclarationI F9 Change Windows F9 Find SymbolS F10 ExitI F11 Compile TPU F11 Execute TPU B F12 End of Line F12 ShowF F13 Expand Token F13 LSE KeysD F14 Previous Page F14 ReviewO F17 Attach F17 Erase PlaceholderdI F18 DCL F18 Goto SourcelK F19 Spawn F19 Previous StepG F20 Compile F20 Next Step B Backspace End of Line Backspace Show! Delete Erase Previous CharF Line Feed Expand Token Line Feed LSE KeysK Return Return Return Trim Trailing[I Space Space Space Expand Tabs M Tab Tab Tab Compress SpacesbJ Ctrl/A Append File Ctrl/A Define AliasM Ctrl/B Erase Previous Word Ctrl/B Erase Next WordeK Ctrl/D Erase Line Ctrl/D Delete BuffereN Ctrl/E Execute Register Ctrl/E Iterate RegisterP Ctrl/F Next Word Ctrl/F Set Flash [Off/On]K Ctrl/G Include Register Ctrl/G Comment Align B Ctrl/H End of Line Ctrl/H ShowM Ctrl/I Tab Ctrl/I Compress SpacestO Ctrl/J Line Feed/Expand Token Ctrl/J LSE Keys [Off/On]B Ctrl/K Remove Ctrl/K SortH Ctrl/L Form Feed Ctrl/L Set SourceK Ctrl/M Return Ctrl/M Trim Trailing G Ctrl/N Count Ctrl/N What LinecJ Ctrl/P Save Register Ctrl/P Comment FillP Ctrl/R Previous Word Ctrl/R Set Match [Off/On]Q Ctrl/T Cut Register Ctrl/T Set Modify [Off/On]aO Ctrl/U Erase Start of Line Ctrl/U Cancel KeynQ Ctrl/V Display Control Ctrl/V Set Scroll [Off/On]/P Ctrl/W Refresh Ctrl/W Set Write [Off/On]B Ctrl/Z Command Mode Ctrl/Z ExitC Ctrl/\ Insert Numeric Ctrl/\ QuoteeI Ctrl/] Insert Date Ctrl/] Insert TimeoA Ctrl/? LSE Command Mode Ctrl/? TPU  20s# Overlayed Key Bindingsn nF Set JournalZ nT Add Delimiter 0T All Delimiters_ -T Clear Delimiters T Standard DelimitersTS -"1" Insert Infile -"2" Insert Outfile T -"3" Insert Buffername -"7" Insert WildcardS 0"7" Set Wildcard n"9" Insert Special_ -"1" Get Environment -"5" Set LanguageuQ -"Enter" Find Reverse -Find Find Reverse" -"." Find Previous- 0F8 Goto Declaration Primarye[ 0F9 Find Symbol Declarations -F9 Find Symbol ReferencesmF Ctrl/P: Add Register Ctrl/T: Append RegisterN Ctrl/V Display Blanks -Ctrl/V Display GraphicsN Ctrl/V Display Tabs nCtrl/V Set Right Margin nCtrl/W Set CursorlI 1Ctrl/Z Compile -Ctrl/Z Quitl2 Line Mode Commands without Key BindingG @filespec Continue Line Insert TextG Set Ask Set Ask Default Set Ask No Set Ask Yesm. Set Verify Set Noverify Type o+)&[WECK.VTEDIT.KIT.V51.B]TPUE]Q..'X9]:76roY`+Vr[7' Gub7e./S}$1BuyN~00~Ton!eI;I.]r~ 7iL 3L v}5ek f?$R2cmX\+A`PBweEzKUIc(MbNL78(da+`+2$34Bz~vW~55 Jlk}AEV'>,13GRh$V:_GEM6.YvZED Y u. bM$+($1xX|$U,q\wv$um\vb ; %01^,-NPgOn- tJsGErG9Y"M8Y=,|n?Hb)$QBw[k:-#-ŘhuR p#PiaQb $od9/{1h i>k"r<3`S/x"y6P weg&%U/ykQTCO\bK[sG*Ys5\j4oHBqG7u+#W9OS{ Lc#zO46pP!_6 hm8>2]-C1[:[#0$;0M'7Evqd _O<)${ j9s7$df_g!S]Tt(%: "Ie?)2{ N#.I5OE?]He0LfK;KDOom5L<0J!Etc\x8nb;^l/O "#&Jn08&]wJEz_=$$Af}wP*Rrzjv^̍QN\6e:u tj?Q dhWy*Ub.,h&KMTx|r?{OBsu|a'[|8/%[toEcac-x#  cgK MPYsA&av,X#vIXm2\}uVs2GW>qVjf:L!| Z bzHN20wzNUVTVce bx.pGM5KAap5]aaQwN1={P P'r"^ ]fOi!#Xr2N:&8HK/ a 8|0[ Axh}g(;t_fmE>/~;ZUE`kkN$"A}@sB {~hkE"-lwF 0d6(]v)qkiq erH7Z:H&%zzc{Y*^j TF$slXts Z,} 2YzSa{f(-S;k9*JPLl/xN m #-B\)t(%Q$j kF@n[F'r^\b,=O,&|guC`b%BS0 YTg\Ol2rL XRCkz&@~8[+p"f8`J"GW,/N3. ZWwcK5t}yv4q!0tn:z>{ O -+41L 5U3`ooY)i?=M)"5 GT2 "d|2AhlLh"KJ W"x{'NWLcqݣɋ÷冢Ʉ⌆#6 `gP3i'\'g];KO GDEfRTQDk6i^LUEOQBfHVY-Kubd)9yc4A+S*_Mtq$U*9&k(0$ ZjwVBqJFXa82}|]OGmoj`st"4&iyz| Qb NYj𘔫X{ ^g,!}Z5srw7-R/])X\N^M TgRP[6j 2P\i.i  gRG|;!?@Jn+%}-7o>\JiK7[4H+r_. S(&D<awpqlTk7jb%'q']D`Xq7/ezgd@x UZV61o?FL +Xg-%)vWU< 8n/Jp{] %&TDzmOwhHC8tV@'"Ty4M1h U 2uP)r$* [&<}uCFlgm2W<[ y"Bκ0P:YOzxM8mJ>CM,>3Yb({;u9z]P( 0)itTb`)S`"sMm66d6&eK7yovAF[Uua 7"t0 vCe([ j\Ns#{6S$Jrxl,O7k]pibHS[ ,BT5xmu]bb1FN&Z."-\C?Er2G`S rAK ~MM4x%8grE}t3oPAH1]cdZ{[j S(`FdKVcF+_MQZ\ ]# }vmJr)8cV{-x<Rc)c=uo\uryvkS-i?>c(a H0LBEtϢhu%+Ì!B*KpgL u LAэHm=L<=1Qg@PcWh.>MtCN0[_'=K,%klcJc>>au-g$% p zjDN#Fg\DGr@oOuI9"sPu zRZI Vt] ]wOK5Uh"HYtr9#iiN`_#oAS5x1buHmwd(A xul)]xU))tF?bzdIv pU{6~'< wfwi#I%:Neku\:sXa71#S8K.KC!TJFii;$"T+^S4?+Q'i MQa6[${]h: iUEkgk(A9_roL <`l+Of>.7n=6+0E]A\qEm+91[fT`'\^b\)LW%3w86UK&_2?9_6G1S?+4S;zqGBR 4A=tZ33+}xU ="nq-CFw Hr/!rlP53QD~@-+T=b- %'DD&fivaZ-b\:2 25Kph].KfPb 0q3/:Z Pn>9MCm /4'm}e f]@ws3 Ls 5l#7OOX+p^exWbtFH.*mNFpurjLLx76S.S <?x(0i^ Vhq  X.!{t'+qQaTEb4?SQV17sG3|`f3\=K\r`kduf&w,<#Pu&xr["JZ~{p\1 |$ ,#V-eNkJK&[ @*Do8ITPUlHUy|KZ~TD*CN5uAFr33cYT7 :B1`)={"f.v*;J iZoC-;8oXR2O+bHGz 3i#z ?{+-,MOI${]kXY%XAK0gNMTse'?@=Kpf/ksmHPj~~X1qg`['NeoHEZCSkfGg< qA[WT-ZQ=(]>0Q*-`xQto9% |"W>o 7%M7D|4m?6:vcOO~$vFMOB!B{TzqqhdY*8MJA>sWq/YgLt+9E6/c'tFb'J 7?LJItdTB9N{"vJw e {O)w=bd|!x {&< 0~ PBa}H ]T&./K;F SlQ m4Rx& 0Gxh[zqcR #3M8H MwD=(E 1l=o']>ks_xuW6yHmK(X2rNU9.Z%2pI-!12~[xG74VfP"YG->:W_B2uw`O6PaGQ9d^!6\t:-jouCQ{R 1t%]%ocHj%g0D1]5hlr5$V7ts7oRXLy\2|KTJKo$&;YAVH72Tzjoux1\_ nF+Eq wUV9j: &Rp- X}HEZPHuNCe]G{CB |Sl|P{$fZ`!n##F ~FN<BabGB(uks+tq@@vA1)E^g<=^{Vm=/xIFF8uzTT]!k/:cTn1E, 7^ I)L]$~1aFupuvI*6lT}.X!Q8N:BG?kuH DqjGl>_bl?J;w%$roU35m7F3NZ+D9?r&gil=5[={"7$")Wu&"ueOM8vE2o=RnJ/,IeMY0aM3_hd4P(Q9u1wo:5~m?#cqpkEg:bvDd #Z"ZG:U*WU5 GJL[cyr1*\e@.0Ld bSc=4\3>ME2IAk1n $hk^ dpsPo\uUu,vP:F,&7W~0'1JX}ml6)jr\u h~^n"HM~nO27y 5R1n' 2y[1tJ|%'n>u65c7$3)CBSXs[:'a m[L4kU XV0Sgcw,rbjfD?/25:H_}1^AUf[3,S{a|`vqvh=uyxJ&]!8nZ QVx$QK#ZxG#g_9&]q=U.E3e}?I@V]Lu[{=ko͋ouGQQ10(CXs*6oծ/75^ Ԙ-1T}Hk:*Iq.5i6ut{k5ZKz.E o=2OJ4zMU!("C+3QD3  L(  \-\5u7Rtn+w0 ' fk >c.#pb=:[VX.H,%_5kZhr#3!,WW&,Q{Bn6BC Mgc$T"{" 7u)])nhVls-f0V\\Fdv e7+8 iuLS aey|_-* zCpduA"[;aPO)W@Azw}[,\ 1~fVrat"QqR_cFj W{ I:EZB>]4XTJh~t>=l 6Wo}Vz"W>Y}^:z|HVRP4!"~Y]lgk#eZOA. !Lj.+rx9e7;'x_#JXrG\J&g0L OTcIjNX)h vC=c\-:Q2z^O^Ts"!x-n|N=wJ83|SHG@MIi28 3@8%zlJ{Z26oH $JG2wpeU`}mZOs/fsn%$uw\WR?UnD$lG'OS (n 57JI)e+yDob&ZW*n JybP=P EKu<>%xED]xF-NNTt Ct&r`umUoF3##= Vl&Lb~YI2TRSKJc^`6 v~8K6ZZfD8-O+%^l)_:m$b,x5JEI~ 4X0 %n Qq\ewr>,jtm vzeDun!FuEdou=bx WY2m[={V.c6$|\~r> `f OCjO -?\ %dr]}FZ%XRWP0@/xfd47JL`E:Q So}~nTg G5H C!DF 9jNonFL C}RY!$(L'/dLKN D^VIYW\z EVjRf\UUL] Bkh9?en LT[fPe`5"5c)h2ZvMSwWSlE]i<:*5%&42t<<+DBYvtjin5$ENJ)%+#u'2+CTF#=e%sSELEC[(+DwF via the first parameter IDISP, used as a dispatch value:C>C IDISP = 1 : Disable Ctrl/T, setup exit handler for re-enab  Qc3 VTEDIT051.Bi)&[WECK.VTEDIT.KIT.V51.B]VTEDIT_VX.HLP;8H*,u&*[WECK.VTEDIT.KIT.V51.B]VTEDIT_VX.HLP;8+,i.*/ 4H**-)0123KPWO+56™蜒7`¡89GHJ1 VTEDITH The VTEDIT command invokes the TPU editor using the VTEDIT interface.H The VAX Text Processing Utility (VAXTPU) is a high performance,H extensible utility that provides several editing interfaces. TheH VTEDIT interface is an efficient, keypad driven editor allowing multiH window editing and providing semi-automatic, context dependent text formatting. Format $ VTEDIT [file-spec] 2 New_userH VAXTPU is a text processing utility available with the VMS operatingH system. High performance and extensibility are two of the majorH features of VAXTPU. The screen oriented text processing features ofH VAXTPU are targeted to the VT200 and VT100 families of terminals, butH they can be used on other ANSI CRTs. VAXTPU can also be used to do batch mode text processing.H The utility consists of a procedural language, a compiler, anH interpreter, and several editing interfaces of which VTEDIT is one. TheH interfaces are written in the VAXTPU language and they are layered onH VAXTPU. You can use VTEDIT or one of the other interfaces to performH editing tasks, and you can use them to access VAXTPU features that> allow you to customize or extend the interface you are using.H After you are familiar with VTEDIT and the functions it provides, useD the VAX Text Processing Reference Manual for information on VAXTPU.H Once you have invoked VAXTPU with the VTEDIT editing interface, you canH get on-line help about both the interface and VAXTPU from within theH VTEDIT interface. This DCL HELP file contains descriptions of theH qualifiers and parameters that can be used with the VTEDIT command at DCL level. 2 Parameters file-specH Specifies the file to be created or edited using the VTEDIT editingH interface. If the file you specify does not exist, the VTEDITH interface provides a buffer in which to create the file. If you writeH out the contents of the buffer VAXTPU will create the file in the appropriate directory.H If you do not provide a file specification as a parameter when youH invoke VAXTPU, the VTEDIT interface will try to find out which fileH was edited last, and re-edit that file. If VTEDIT's memory is empty,H VTEDIT will create an empty buffer named '$Main' having no output file name associated with it.H VAXTPU does not provide a default file type when creating files; ifH you do not include a file type, it is null. The file must be a disk& file on a Files-11 formatted volume.H You may use wildcards to specify the file to be edited. If there isH exactly one file matching the given wildcard, this file is edited. IfH there are several files matching, VTEDIT displays a list of theirH names and lets you select one of the files from this list. (ThisH feature is not fully available if VTEDIT is invoked with LSE support;H in this case, the first file matching the wildcard is selected always,, even if there are several files matching.)2 Command_Qualifiers/COMMAND /COMMAND[=command-file] (D) /NOCOMMANDH Determines whether VTEDIT reads a user-written VAXTPU source file forH initialization purposes. The default file type for command files isH TPU. By default, VTEDIT tries to read a file called VTE$COMMAND.TPUH from your default directory. You can use a file specification after theH /COMMAND qualifier or define the logical name VTE$COMMAND to point to a) command file other than the default one.H If VTEDIT is invoked with LSE support, the logical name LSE$COMMAND isH an alternative to the /COMMAND command qualifier. If /COMMAND orH /NOCOMMAND does not appear on the command line, VTEDIT attempts toH translate the logical name LSE$COMMAND. If it has a translation, that? value is used in the same way as the /COMMAND qualifier value.H To prevent VTEDIT from processing a command file, use the /NOCOMMANDH qualifier. When you are not using a command file, specifyingH /NOCOMMAND decreases startup time by eliminating the search for a command file./CREATE /CREATE (D) /NOCREATEH Controls whether VAXTPU creates a new file when the specified inputH file is not found. The VTEDIT interface is responsible for processingH this qualifier. By default, the VTEDIT interface provides a buffer inH which to create the file. If you write out the contents of the bufferH (either explicitly or by exiting from the editor), VAXTPU will create aH new file for the input file specification. When you use the /NOCREATEH qualifier and enter a file specification that does not exist, VTEDIT1 returns you to the DCL command level as follows: $ VTEDIT/NOCREATE NEWFILE.DATH (VTEDIT clears the screen and displays a message similar to the following:)4 Input file does not exist: DISK$:[USER]NEWFILE.DAT; $ /CURRENT_FILE /CURRENT_FILE (D) /NOCURRENT_FILEH If no input file is specified on the command line, /CURRENT_FILEH specifies that the name and type of the file that was edited last beH used as the input file. If an incomplete file specification isH specified on the command line (that is, only a file name or a fileH type), /CURRENT_FILE specifies that the name or the type of theH previously edited file be used to complete the file specification. IfH /NOCURRENT_FILE is specified, VTEDIT will not use its memory to resolve; an input file specification. /CURRENT_FILE is the default.H This qualifier is only valid if VTEDIT has been installed with LSEH support and if the qualifier /NOLSE is not present on the command line./DISPLAY( /DISPLAY[=display-filespec] (default) /NODISPLAYH Determines whether the editing session is being run on a supportedH terminal and is using terminal functions, such as the screen display and keyboard.H By default, sessions are run with a screen management file calledH TPU$CCTSHR.EXE, for ANSI terminals. If VTEDIT is used with LSE support,H the default screen management file is LSE$CCTSHR.EXE. For moreH information about VAXTPU-supported terminals, see the VAX Text Processing Utility Manual.H Use /NODISPLAY when you want to run VTEDIT in batch mode, or when youH are using an unsupported terminal -- that is, without using the screen display and keyboard functions.H The qualifier /NODISPLAY is not supported if VTEDIT is invoked with LSEH support; this qualifier must be combined with the qualifier /NOLSE if, VTEDIT has been installed with LSE support. /ENVIRONMENT /ENVIRONMENT=file-spec-list /NOENVIRONMENT (D)H Specifies the name of one or more binary environment files containingH Editor language, token, placeholder, or alias definitions. The Editor6 reads in these definitions as part of Editor startup.H The file-spec-list is either a single file-spec or a list of file-specs1 separated by commas and enclosed in parentheses.H If definitions or deletions of items ap 9 VTEDIT051.Bi)&[WECK.VTEDIT.KIT.V51.B]VTEDIT_VX.HLP;8H*pear in more than one file, theD definition that appeared in the first listed file takes precedence.H SYS$LIBRARY is the default device, and the default file type is .ENV.H The logical name LSE$ENVIRONMENT is an alternative to the /ENVIRONMENTH qualifier. If /ENVIRONMENT or /NOENVIRONMENT is not used, the EditorH will attempt to translate the logical name LSE$ENVIRONMENT. If theH logical name has translations, the values are used in the same way asH the /ENVIRONMENT qualifier values. The Editor translates the first ten/ indices of the logical name LSE$ENVIRONMENT.H This qualifier is only valid if VTEDIT has been installed with LSEH support and if the qualifier /NOLSE is not present on the command line./INITIALIZATION /INITIALIZATION=file-spec /NOINITIALIZATION (D)H Determines whether VTEDIT reads a user-written initialization fileH containing a sequence of VTEDIT commands to be executed as part ofH Editor startup. The default file type for initialization files is VTE.H By default, VTEDIT tries to read a file called VTE$INIT.VTE from yourH default directory. You can use a file specification after theH /INITIALIZATION qualifier or define the logical name VTE$INIT to point5 to a initialization file other than the default one.H If VTEDIT is invoked with LSE support, the startup commands that VTEDITH expects are LSE commands and not VTEDIT commands. Also, the logicalH name LSE$INITIALIZATION is an alternative to the /INITIALIZATIONH qualifier. If /INITIALIZATION or /NOINITIALIZATION is not used, theH Editor will attempt to translate the logical name LSE$INITIALIZATION.H If the logical name has a translation, that value is used in the same, way as the /INITIALIZATION qualifier value./JOURNAL /JOURNAL[=journal-file] (D) /NOJOURNALH Determines whether VAXTPU keeps a journal file of your editing sessionH so that you can recover from an interrupted session. The VTEDITH interface is responsible for processing this qualifier. By default,H the VTEDIT interface maintains a journal file that has the same name asH the input file and a file type of TJL. If you invoke VAXTPU without aH file specification, the default name for the journal file is TPU.TJL.H Use a full file specification with the /JOURNAL qualifier to specify a% different name for the journal file.H If you are editing a file from another directory and want the journalH file to be located in that directory, you must use the /JOURNALH qualifier with a file specification that includes the directory name.E Otherwise, VAXTPU creates the journal file in the default directory.H To prevent VAXTPU from keeping a journal file for your editing session, use the /NOJOURNAL qualifier.H See the /RECOVER qualifier for information on how to have VAXTPU2 process the commands contained in a journal file. /LANGUAGE /LANGUAGE=languageH Sets the language for the current input file, overriding the language) indicated by the input file's file type.H This qualifier is only valid if VTEDIT has been installed with LSEH support and if the qualifier /NOLSE is not present on the command line./LSE /LSE /NOLSEH Controls whether VTEDIT loads the Language-Sensitive Editor VAX LSE orH not. The Language-Sensitive Editor is a multi-language advanced textH editor specifically designed for software development, available as aH layered product for VMS. If VTEDIT is installed with LSE support, LSEH will be loaded together with VTEDIT, unless this is explicitly. inhibited by specifying the /NOLSE qualifier.C Use of this Qualifier requires presence of VAX LSE on your system./MODIFY /MODIFY (D) /NOMODIFYH Specifies whether the buffer created for the input file is modifiableH or unmodifiable. If you specify the /MODIFY qualifier, the VTEDITH command creates a modifiable buffer. If you specify the /NOMODIFYH qualifier, the VTEDIT command creates an unmodifiable buffer. If youH do not specify either qualifier, VTEDIT determines the buffer'sH modifiable status from the read-only/write setting. By default, aC read-only buffer is unmodifiable and a write buffer is modifiable./OUTPUT /OUTPUT=output-file (D) /NOOUTPUTH Determines whether VAXTPU creates an output file at the end of yourH editing session. The VTEDIT interface is responsible for processingH this qualifier. By default, the VTEDIT interface uses the same fileH specification for both the input file and the output file. The outputH file has a version number one higher than the highest existing versionH of the input file. Use a file specification with the /OUTPUT qualifierH to specify a file name that is different from the input file. You canH include directory information as part of your output file specification% to send output to another directory.H The /NOOUTPUT qualifier suppresses the creation of an output file forH the main buffer, but not the creation of a journal file. If you invokeH VAXTPU with /NOOUTPUT and then decide you want an output file, use oneH of the output commands in the VTEDIT interface before you end the> editing session to write out the contents of the main buffer. /READ_ONLY /READ_ONLY /NOREAD_ONLY (D)H Determines whether VAXTPU keeps a journal file and creates output filesH from the contents of the main buffer and from any other user buffers.H With the default /NOREAD_ONLY, VAXTPU maintains a journal file andH creates output file from the contents of any buffers that you modified.H Using the /READ_ONLY qualifier is like using the /NOJOURNAL qualifierH for the editing session and the /NOOUTPUT qualifier for all buffers.H When you specify /READ_ONLY, VAXTPU does not maintain a journal fileH for your editing session, and the NO_WRITE attribute is set for allH user buffers. When a buffer is set to NO_WRITE, the contents of theH buffer will not be written out when you leave VTEDIT. Both the EXIT andH QUIT built-in procedures will end the editing session without creatingH a new file from the contents of the user buffers (even if you modified them).H Use /READ_ONLY when you are searching a file. If you change your mindH and want to save any edits you make to the file, use the Write Text toH Output File command to write the currently selected range to anG external file. Remember, however, that you do not have a journal file./RECOVER /RECOVER /NORECOVER (D)H Determines whether VAXTPU reads a journal file at the start of an- editing session. The default is /NORECOVER.H When you use the /RECOVER qualifier, VAXTPU reads the appropriateH journal file and processes whatever commands it contains. If theH journal file type is not TJL or if the file name is not the same as theH input file name, you must include both the /JOURNAL=journal-file& qualifier and the /RECOVER qualifier.H When you are recovering a session, all files must be in the same stateH as they were at the start of the editing session being recovered. AllH terminal characteristics must also be in the same state as they were atH the start of the editing session being recovered. Check especially the$ following terminal characteristics: 1. Device_Type 2. Edit_mode 3. Eightbit 4. Page 5. WidthH Furthermore, all initialization and environment files used in the4 original run must be used in the recovery run,  VTEDIT051.Bi)&[WECK.VTEDIT.KIT.V51.B]VTEDIT_VX.HLP;8H*too./START_POSITION! /START_POSITION=(Line,Character) /START_POSITION=(1,1) (D)H Specifies the starting line and character in the file. If a fileH specification is not specified, the last specification invoked by theH Editor is used. The cursor is positioned at the place corresponding toH the cursor's location at the time the last Editor-invoked file was left./SYSTEM_ENVIRONMENT /SYSTEM_ENVIRONMENT=file-spec /NOSYSTEM_ENVIRONMENT (D)+ /SYSTEM_ENVIRONMENT=LSE$SYSTEM_ENVIRONMENTH Specifies the name of a system environment file. The differenceH between files specified by this qualifier and those specified by aH /ENVIRONMENT qualifier is: Definitions derived from this qualifier/ cannot be saved by a SAVE ENVIRONMENT command.H This qualifier is only valid if VTEDIT has been installed with LSEH support and if the qualifier /NOLSE is not present on the command line./WRITE /WRITE (D) /NOWRITEH Specifies that the file on the VTEDIT command line be put into aH writeable modifiable buffer. The /NOWRITE qualifier specifies that theH file on the VTEDIT command line be put into a read_only unmodifiable buffer.2 MemoryH VTEDIT automatically remembers the file being edited. If you invokeH VTEDIT without specifying a file-spec, VTEDIT will read its memory and re-edit the last edited file.H VTEDIT's memory is controlled by the logical name TPU$MEMORY. If theH logical name TPU$MEMORY translates to a string of the form $filespec,H VTEDIT uses the specified file for its memory. Otherwise, VTEDIT usesH the logical name itself as the memory. On exiting, the edited file'sH name is stored in a process logical name called TPU$MEMORY, or, if thisH name translates to a string of the form $filespec, the edited file's& name is stored in the specified file.H For compatibility with previous, TECO-based releases of VTEDIT, theH logical name TEC$MEMORY is used instead of TPU$MEMORY, if TPU$MEMORY% translates to the string TEC$MEMORY.aH If the Language-Sensitive Editor is installed and has set its own fileH memory, VTEDIT uses this memory instead of its own memory. In this1 case, VTEDIT updates both memories upon exiting. 2 WildcardshH You may use a wildcard to specify the file VTEDIT should read and edit.H If this wildcard unambiguously identifies a file, VTEDIT opens thatH file just as if the resulting filespec had been given instead of theH wildcard. If no filespec matches the wildcard, VTEDIT creates an emptyH buffer whose name is the wildcard with any asterisks and/or percent signs removed. H If, on the other hand, several files match the wildcard given, VTEDITH displays a menu containing all these filenames in the lower half of theH screen, and positions the cursor on the first filename. Using the arrowH keys and/or the Next Screen and Prev Screen keys, you may position toH the file that you wish to edit. Pressing the Return or the Select keyH selects that file for editing; VTEDIT then removes the menu and readsH the selected file. On a workstation, you may also select the file by8 pointing to it with the mouse and pressing a mouse key.H If VTEDIT is invoked with with LSE support and several files areH matching the wildcard given, the first file matching the wildcard isH always selected; LSE gives no indication that there are more files matching the wildcard.uH Using a wildcard to select VTEDIT's input file also sets up a wildcardH search. So, the This File command ( PF3) will present additionalH files matching the wildcard and will ask whether these files are to beH edited, too. This allows editing several or all files matching a givenH wildcard in one editing session, without having to worry what the name of the next file could be.i 2 Examples, 1. $ VTEDIT/OUTPUT=NEWFILE.TXT OLDFILE.TXTH This VTEDIT command invokes VAXTPU to edit the file OLDFILE.TXT usingH the section file SYS$LIBRARY:VTE_SECTION.TPU$SECTION that creates theH VTEDIT editing interface. VAXTPU then tries to read the command fileH VTE$COMMAND.TPU in your default directory. If you have not defined theH logical name VTE$COMMAND to point to a user-written command file, andH if you do not have a file named VTE$COMMAND.TPU in your defaultH directory, VAXTPU does not read a command file. If you modify the mainH buffer and use the Exit command to end the session, the edited file has the name NEWFILE.TXT. 2. $ VTEDIT OLDFILE.TXTiH This VTEDIT command invokes VAXTPU with the VTEDIT editing interface.H VAXTPU makes a copy of the file OLDFILE.TXT available for editing. WhenH you leave the editing session, VAXTPU creates a new version of the fileH with a version number one higher than the highest existing version number for that file.H If the Language-Sensitive Editor is present and if VTEDIT has beenH installed with LSE support, VTEDIT invokes the Language-Sensitive1 Editor, providing an enhanced command interface.i! 3. $ VTEDIT/RECOVER OLDFILE.TXTMH This VTEDIT command invokes VAXTPU with the VTEDIT editing interface toH recover from an abnormal exit during a previous editing session. VAXTPUH opens the file OLDFILE.TXT, and then processes the journal fileH OLDFILE.TJL. Once the journal file has been processed, you can resume interactive editing.o 4. $ VTEDIT/NOLSE OLDFILE.TXTeH This command suppresses the automatic loading of the Language-H Sensitive Editor VAX LSE, if VTEDIT has been installed with LSEH support, and instead uses a version of VTEDIT that is identical toH VTEDIT on systems without VAX LSE. VTEDIT makes a copy of the fileH OLDFILE.TXT available for editing. When you leave the editing session,H VAXTPU creates a new version of the file with a version number one? higher than the highest existing version number for that file.r2 5. $ VTEDIT /ENVIRONMENT=LOCAL /LANGUAGE=FORTRANH This command, which requires presence of the Language-Sensitive EditorH VAX LSE, invokes VTEDIT with the LSE enhanced editing interface. VTEDITH opens the file that was edited using LSE with VTEDIT or native LSE,H whichever occured most recently, and makes language support for theH Fortran language available for editing. VTEDIT uses a local environment5 definition stored in the file SYS$LIBRARY:LOCAL.ENV./&*[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13+,W./ 4-)0123 KPWO56qtL-7F89GHJ% VAX-11 Librarian V04-00`L- *V- f5!l VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;134fr@FILEb ADD_DELIMITERx ADD_REGISTERALL_DELIMITERS: APPEND_FILEAPPEND_REGISTERATTACHVBOTTOM BOUND_CURSORBUFFER.CAPITALIZE_WORD CENTER_LINE CHANGE_CASECHANGE_WINDOWS zCLEAR_DELIMITERS!z CLOSE_FILE"*COMPILE# COMPILE_TPU$COMPRESS_SPACES%CONTINUE%COUNT& CUT_REGISTER'DCL)fDECREASE_INDENT Match_Control_CharactersNumeric_Argumentj Prompting]%COUNT& CUT_REGISTER'DCL)fDECREASE_INDENT* DELETE_BUFFER+DISPLAY_BLANKS*DISPLAY_CONTROL+XDISPLAY_GRAPHICS-R DISPLAY_TABS-DO. END_OF_LINE. ERASE_LINE/ERASE_NEXT_CHAR0<ERASE_NEXT_WORD0ERASE_PREVIOUS_CHAR2ERASE_PREVIOUS_WORD3ERASE_START_OF_LINE3EXCHANGE5 EXECUTE_LEARNED4EXECUTE_REGISTER5R EXECUTE_TPU6HEXIT Match_Control_CharactersNumeric_Argumentj PromptingCONTINUEEXCHANGEINCREASE_INDENT LINE_MODE ONE_WINDOW SAVE_REGISTER SET_JOURNAL SET_SEARCH_CASE_ANYSPAWN WRITE_RANGENG\5 EXECUTE_LEARNED4EXECUTE_REGISTER5R EXECUTE_TPU6HEXIT6x EXPAND_TABS7 FILE_SEARCH7FILL8FIND9 FIND_MARK:b FIND_NEXT; FIND_PREVIOUS; FIND_REVERSE=n FORMATTER< FORM_FEED? FREE_CURSOR@ GET_NEXT_WORDAzHELPB8 INCLUDE_FILEBINCLUDE_REGISTERDXINCREASE_INDENTEINDENTFINDENT_CONTINUATIONG INDENT_LESSH INDENT_MORE Match_Control_CharactersNumeric_Argumentj PromptingREINDENTFINDENT_CONTINUATIONG INDENT_LESSH INDENT_MOREIINSERT_BUFFERNAMEI INSERT_DATEJ INSERT_INFILEJ| INSERT_MARKKhINSERT_NUMERICL(INSERT_OUTFILEM.INSERT_SPECIALM INSERT_TEXTM INSERT_TIMENvINSERT_WILDCARDNITERATE_REGISTEROLEARNPLINEP LINE_MODEQLLINE_MODE_EDITORS LIST_BUFFERST LOWERCASEU<MARK Match_Control_CharactersVMENUNumeric_Argumentj PromptingdQLLINE_MODE_EDITORS LIST_BUFFERST LOWERCASEU<MARK Match_Control_CharactersVMENUY MOUSE_PASTEVMOUSE_POSITIONX MOUSE_SELECTZ MOVE_DOWNZ MOVE_LEFT[ MOVE_RIGHT\*MOVE_UP\ NEXT_BUFFER] NEXT_LINE]R NEXT_PAGE^@ NEXT_SCREEN^z NEXT_WORDNumeric_Argument_ ONE_WINDOW` OTHER_WINDOWbHPASTEc PREVIOUS_LINEd| PREVIOUS_PAGEdPREVIOUS_SCREENe PREVIOUS_WORDj PromptingfZQUITc` OTHER_WINDOWbHPASTEc PREVIOUS_LINEd| PREVIOUS_PAGEdPREVIOUS_SCREENe PREVIOUS_WORDj PromptingfZQUITg,QUOTEht READ_FILEjREFRESHkVREMOVEl REMOVE_MARKmNREPEATm,REPLACEn REPLACE_ALLp RESET_INDENTp RESET_JOURNALqRESTORErRETURNsrSAVEt SAVE_REGISTERu` SCROLL_DOWNv SCROLL_UPwSELECTxSELECT_RECTANGULAR{SET_ASK{SET_ASK_DEFAULT|l SET_ASK_NO| SET_ASK_YESeu` SCROLL_DOWNv SCROLL_UPwSELECTxSELECT_RECTANGULAR{SET_ASK{SET_ASK_DEFAULT|l SET_ASK_NO| SET_ASK_YES}SET_CASE}SET_CASE_LOWER~SET_CASE_UPPER~ SET_CURSORz SET_FLASH SET_FLASH_OFF SET_FLASH_ON SET_FORMATTERpSET_FORMATTER_OFFhSET_FORMATTER_ON SET_JOURNALSET_LEFT_MARGIN SET_MATCH SET_MATCH_OFF SET_MATCH_ONSET_MODESET_MODE_INSERTSET_MODE_OVERSTRIKEZSET_LEFT_MARGIN SET_MATCH SET_MATCH_OFF SET_MATCH_ONSET_MODESET_MODE_INSERTSET_MODE_OVERSTRIKE SET_MODIFY&SET_MODIFY_OFF SET_MODIFY_ON SET_NOVERIFYSET_RIGHT_MARGIN SET_SCROLLSET_SCROLL_OFF SET_SCROLL_ONVSET_SEARCH_CASE\SET_SEARCH_CASE_ANYSET_SEARCH_CASE_EXACTPSET_SEARCH_ORIGINSET_SEARCH_ORIGIN_TOPpSET_TABS SET_TABS_ATSET_TABS_EVERY SET_VERIFY  GL-1 Match_Control_Characters Match Control CharactersJ Search strings may contain match control characters allowing the/ specification of more general search criteria: ^M newline! ^X any character( ^S any non-alphanumeric, ^N x any character except "x"' ^E n x n occurences of "x"* ^E A any letter A...Z a...z( ^E B any non-alphanumeric6 ^E C any symbol constituent A...Z $ . _# ^E D any digit 0...9F ^E E x exactly the character "x" (without interpretation)1 ^E G q any character in Q-register q6 ^E L any line terminator ' ^E M x any sequence of "x"; ^E N any supplemental (multinational) letter@ ^E P any TPU pattern (delimited by a second ^E P)0 ^E Q q the contents of Q-register q6 ^E R any alphan umeric A...Z a...z 0...94 ^E S any sequence of blanks and . ^E T any sequence of charactersE ^E U q the ASCII character whose code is in Q-register q. ^E V any lowercase letter a...z. ^E W any uppercase letter A...Z! ^E X any character< ^E [x...y] anyone of the characters from "x" to "y"? The following constructs may be used in replacement arguments: ^M newlineF ^E E x exactly the character "x" (without interpretation)0 ^E Q q the contents of Q-register qI ^E n the string found for the n-th match control constructww |L-1 Numeric_Argument Numeric Argument# Format: numeric expression5 Numeric Expression Operators0 + Addition - Subtraction- * Multiplication / Division& = Evaluate current arg1 op arg2$ ^- Change sign of current arg21 Radix Change CommandsH ^D decimal (base 10) ^O octal (base 8) ^X hex (base 16)- "arg2" Stand-ins' ^- The inverse (negative) of arg2 ^. Current line number9 ^Z Current total number of lines in the text buffer? ^L The distance to the end of the current line if arg2 is= positive, otherwise to the start of the current line/ ^N The result of the last Count operation ^^x Value of character 'x'5 ^Qq Contents of the numeric part of Q-register q@ ^A Value of the character at distance 'arg2' to the cursorF ^\ Value of the number in the text buffer, immediately following/ the cursor, or 0 if there is no number@ ^Ctrl/\ The same, but deleting this number from the text bufferww@L- 1 Prompting PromptingJ Terminate Prompts via the keypad key "." or, on VT200 terminals, via theJ "Do" key. Prompts for V!c VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13_TEDIT commands or file and buffer names are also4 terminated by "Return". Reject Prompting by Ctrl/Z.ww@RL-1 @FILE @FILEJ Executes a command file you specify, containing VTEDIT commands. Using aJ command file lets you set editing preferences, or execute a series ofJ related commands, without having to type each command. The default file type for command files is .VTE.J You can use more than one command file in a session, but execute only one3 at a time. You cannot use @ to nest command files./ This command can only be given from line mode.ww@L-1 ADD_DELIMITER ADD DELIMITERJ Add the character whose ASCII value is n to the set of word delimiters.? The value of the numeric argument n must be between 1 and 255.H The T key with a positive numeric argument invokes this command.ww@L-1 ADD_REGISTER ADD REGISTERJ Append n lines from the current buffer to Q-register q. In this command,J q can  be any any letter; uppercase and lowercase letters are treated asJ equivalent. If the numeric argument n is not given and a range has beenJ selected, append the text of this range. If a rectangular region has beenJ selected, append the text inside this rectangle. Otherwise, append one? line. VTEDIT moves the cursor to the end of the appended text.J The Ctrl/P key, followed by a colon (:) and a letter, invokes this command.ww@L-1 ALL_DELIMITERS ALL DELIMITERSJ Use a set of word delimiters appropriate for editing program code. ThisJ command appends the following special characters to the set of word delimiters:4 ( ) [ ] < > { } _+ - _* ! = : / . ; $ __ ' "D The T key with a zero numeric argument invokes this command.ww@&L- 1 APPEND_FILE APPEND FILEJ Get a file name from the keyboard and append this file to the current text buffer.J VTEDIT reads the specified file from the file system, and appends it toJ the current text buffer. The text pointer is moved to the start of theE newly read text, i.e. just beyond the former end of the text buffer.% The Ctrl/A key invokes this command.ww@[L-1 APPEND_REGISTER APPEND REGISTERJ Append n lines from the current buffer to Q-register q and delete themJ from their original location. In this command, q can be any any letter;J uppercase and lowercase letters are treated as equivalent. If the numericJ argument n is not given and a range has been selected, append and deleteJ the text of this range. If a rectangular region has been selected, appendJ and delete the text inside this rectangle. Otherwise, append and deleteC one line. VTEDIT moves the cursor to the end of the appended text.D The deleted text can be inserted back by typing the "6" keypad key.J The Ctrl/T key, followed by a colon (:) and a letter, invokes this command.ww@L-1 ATTACH ATTACHJ  Attach suspends the current VTEDIT editing session and reconnects theJ terminal to the parent process, if VTEDIT is run in a subprocess. UsuallyJ the parent Process is your top-level DCL process. If there is no parent, process, VTEDIT prompts for a process name.J By using the DCL-level SPAWN and ATTACH commands in addition to theJ VTEDIT Attach command, you can keep one editing session active for yourJ entire VMS session. This makes it faster to resume editing, but takes up more system resources./ The I and F17 keys invoke this command.ww@L-1 BOTTOM BOTTOM: BOTTOM moves the cursor to the end of the current buffer.) The keypad "2" key invokes this command.ww@ M-1 BOUND_CURSOR BOUND CURSORJ Select bound cursor movement. With bound cursor movement, the cursorJ follows the flow of your text. For instance, moving forward at the end ofJ a line will position you to the start of the next line, or moving down toJ a line shorter than the current offset from the left margin will position/ you to the end of that line and not beyond it.) The "<" key invokes this command.ww@/M-1 BUFFER BUFFERJ The Buffer command puts a new buffer in the current window. The cursorJ moves to the position it was in the last time you used this buffer.J Buffer names are displayed in the status line at the bottom of theJ window. You can use the Show and List Buffers commands to find out which buffers you have used.J Some VTEDIT commands, such as Do, can display many error messages tooJ rapidly to read. You can use the Buffer command to see these messages by" selecting the buffer "$MESSAGES".0 The keypad "3" key invokes this command.ww@d"M-1 CAPITALIZE_WORD CAPITALIZE WORDJ Capitalize Word capitalizes one or more words by making the first letterJ uppercase and the remaining letters lowercase. If a range has been J selected, all words in this range are capitalized, and the cursor movesJ to the end of the selected range. Otherwise, if the number of wordsJ specified is positive, words are capitalized towards the end of theJ buffer, and if this number is negative, towards the beginning of theJ buffer. The cursor moves to the end of the last word capitalized, if theJ number of words is positive, otherwise to the beginning of the first word.' The Q key invokes this command.ww@.M- 1 CENTER_LINE CENTER LINEJ CENTER LINE centers the current line between the left and right margins.J You may place the cursor anywhere on the line to be centered before using CENTER LINE.' The O key invokes this command.ww@:M- 1 CHANGE_CASE CHANGE CASEJ If a range has been selected, change within this range any uppercaseJ letter to lowercase, and any lowercase letter to uppercase. Otherwise,J change the case of the next n characters, starting at the current textJ pointer. If n is positive, the command operates toward the end of the$ buffer, otherwise to the beginning.' The Z key invokes this command.ww@GM-1 CHANGE_WINDOWS CHANGE WINDOWSJ The Change Windows command allows you to create two or more sections onJ the screen, making it possible to view different parts of one file, orJ different documents. When you view one file in two windows, whatever youJ do to o ne is done to the other. This is not true when viewing two different files in two windows.J If there is one window on the screen, Change Windows takes the currentJ window and divides it into two smaller windows. The current buffer isJ displayed in both windows, and the cursor is moved to the bottom window.J To view two different files at the same time, use the Buffer or Read FileJ commands after using Two Windows to put a new buffer or file in theJ current window, or ci rcle through the available buffers by (repeatedly) using the Next Buffer command.J If there are already two windows on the screen, the Change WindowsJ command returns the screen to one view of the current buffer. The windowJ the cursor is in becomes the current window. If you have been viewing twoJ different documents in the two windows, VTEDIT removes the other windowJ from the screen. The contents of the other buffer are not affected; youJ can return to editing this buffer b9t VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13U !y using the Buffer or Next Buffer command.J If the Change Windows command is given with a numeric argument, the valueJ of this argument determines the number of windows to be displayed. TheJ maximum number of windows depends on the length of the terminal screen,. as each window requires at least three lines.! The F9 key invokes this command.ww@8SM-1 CLEAR_DELIMITERS CLEAR DELIMITERSJ Clear out the word delimiter set. You must follow this command by addi"ng one or more word delimiters.H The T key with a negative numeric argument invokes this command.ww@m_M- 1 CLOSE_FILE CLOSE FILEJ Write the contents of the current text buffer to its associated outputJ file. After this operation, the current text buffer is deleted, and oneJ of the remaining text buffers is made current. If there are currently noJ other text buffers, an empty text buffer named "$MAIN" is created and made current.0 The keypad # "8" key invokes this command.ww@kM- 1 COMPILE COMPILEJ Write the contents of the current text buffer to its associated outputJ file. Additionally, the output file is compiled using the site-specificJ DCL command COMPILE which may be a DCL symbol equated to a DCL command orJ a DCL command procedure. The current text buffer is not changed by this4 command, and the text pointer retains its position.J With LSE support, VTEDIT forms a DCL command line by appending $the fileJ spec of the current buffer to the command-string specified with theJ Compile command. If the associated language has diagnostic capabilities,J /DIAGNOSTICS is appended to the DCL command formed. VTEDIT then spawns aJ subprocess to execute the command line. When the subprocess completes, a, message is displayed in the message window.J The 1 Ctrl/Z keystroke sequence invokes this command, as does the F20 key on VT200 terminals.ww@wM- 1 COMPILE_TPU% COMPILE TPUJ Compile the next n lines as VAXTPU source code. If n is not given and a- range has been selected, compile this range.1 The "." and F11 keys invoke this command.ww@ M-1 COMPRESS_SPACES COMPRESS SPACESJ Compress multiple spaces to Tabs, using the current Tab setting, withinJ the next n lines. If n is not given and a range has been selected,' perform the compression on this range.+ The "Tab" key invokes this command.ww&@AM- 1 CONTINUE CONTINUE4 Leave command input mode and resume keypad editing.J This command can only be given from line mode; it is disabled if VTEDIT is run in /NODISPLAY mode.ww@vM-1 COUNT COUNTJ Search and count occurrences of a search string. End the string byJ pressing the keypad period (.) or, on VT200 terminals, the DO key. AfterF the command, the text pointer is always left at its current position.J If a range has been sele'cted before giving the Count command, search7 string occurrences are counted only inside this range.J NOTE: Depending on the number of occurrences found, this command may be quite time consuming.% The Ctrl/N key invokes this command.ww@M-1 CUT_REGISTER CUT REGISTERJ Copy n lines from the text buffer into Q-register q and delete them fromJ their original location. In this command, q can be any letter. UppercaseJ and lowercase letters are treated as equivalen(t. If n is not given and aJ range has been selected, copy and delete the text in this range. If aJ rectangular region has been selected, cut the text inside this rectangle,J and, if the current mode is overstrike, replace it with blanks.% Otherwise, copy and delete one line.D The deleted text can be inserted back by typing the "6" keypad key.< The Ctrl/T key, followed by a letter, invokes this command.ww@M-1 DCL DCLJ The DCL command executes a DCL (D )igital Command Language) command from VTEDIT.J The DCL command and the resulting output go into a special DCL buffer.J Once the command is executed, two windows appear on the screen. TheJ second window is associated with the DCL buffer. The cursor remains inJ the window it was in before you issued the DCL command. (A VAX/VMSC limitation prevents DCL prompts from appearing in the DCL buffer.)J The DCL buffer is treated just like any other buffer. You can move output%* from a DCL command into a text file./ The J and F18 keys invoke this command.ww@M-1 DECREASE_INDENT DECREASE INDENTJ If the Query Language formatter is active, set the value for indentationJ increment and decrement to 2. This command does not perform anyI indentation; it simply presets a value for further indentation commands.J If the Cobol formatter is active, mark the current line as a continuation% line by inserting a "-" in column 7.J T+he "-" key, if typed at the start of a line, invokes this command, if< either the Cobol or the Query Language formatter is active.ww@JM-1 DELETE_BUFFER DELETE BUFFERJ Delete the current text buffer. After this operation, one of theJ remaining text buffers is made current. If there are currently no otherJ text buffers, an empty text buffer named "$MAIN" is created and made current., The Ctrl/D key invokes this command.ww@M-,1 DISPLAY_CONTROL DISPLAY CONTROLJ This command turns on the scope driver graphic-Tabs mode, or turns it off if it is currently on.> The Ctrl/V key without numeric argument invokes this command.ww@M-1 DISPLAY_BLANKS DISPLAY BLANKS; This command turns off the scope driver graphic-Tabs mode.ww@M-1 DISPLAY_GRAPHICS DISPLAY GRAPHICSJ This command displays the text windows without any interpretation orJ replacement of control cha -racters. For instance, if there are EscapeJ sequences in the text, they control the terminal display instead of beingJ displayed as text. This feature is useful to see the effect of hard+ coding terminal control strings in a text.J As, in this mode, the position of the cursor may not reflect the text? pointer position, all user buffers are set to be unmodifiable.J To reverse the effects of this command, use the Ctrl/V key (the DisplayJ Blanks command). This command will also. set any buffers to be modifiableJ if they were so before the Display Graphics command. The screen mayJ appear garbeled in some circumstances when returning to the normal@ display mode; in this case, enter the Ctrl/W (Refresh) command.F The Ctrl/V key with a negative numeric argument invokes this command.ww@M-1 DISPLAY_TABS DISPLAY TABS: This command turns on the scope driver graphic-Tabs mode.ww@S N-1 DO DOJ The Do command lets y/ou execute a VTEDIT command in line mode. TerminateJ the command by typing the RETURN or DO key. You may recall previous/ commands by typing the up and down arrow keys.! The Do key invokes this command.ww@N- 1 END_OF_LINE END OF LINE> This command moves the cursor to the end of the current line.9 The BACKSPACE, F12, and Ctrl/H keys invoke this command.ww@"N- 1 ERASE_LINE ERASE LINEJ Erases from the current cursor position to the ene VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13,/0d of the current line.C The erased line can be inserted back by typing the "6" keypad key.% The Ctrl/D key invokes this command.ww@.N-1 ERASE_NEXT_CHAR ERASE NEXT CHARJ Erases the character at the current cursor position. The rest of the the1 line moves left one space to close up the space.J When the cursor is at the end of a line, the Return at the end of thatJ line is deleted. The text on the next line is moved to the right of the text in the current lin1e.) The keypad "5" key invokes this command.ww@';N-1 ERASE_NEXT_WORD ERASE NEXT WORDJ Erases the last part of current word and moves the cursor to the start ofJ the next word. If the cursor is between words, then the next word isJ erased. If the cursor is at the end of a line, the next line will beJ appended to the current line. The erased word can be inserted back by typing the "6" keypad key., The Ctrl/B key invokes this command.ww 2@\GN-1 ERASE_PREVIOUS_CHAR ERASE PREVIOUS CHARJ Deletes the character preceding the cursor. In Insert mode the rest ofJ the the line moves left one space to close up the space. In OverstrikeJ mode, the character preceding the cursor is replaced by a space and the: rest of the line remains in the same place on the screen.J When the cursor is at the start of a line, the Return at the end of theJ previous line is deleted. The text on the current line is moved to the% r 3ight of the text in the line above.J On VT200 series terminals, the X key invokes this command.ww@N- 1 EXECUTE_TPU EXECUTE TPUJ Execute the next n lines as VAXTPU source code. If n is not given and a- range has been selected, execute this range.78 The "," and F11 keys invoke this command.ww@ϜN-1 EXIT EXITJ The EXIT command leaves the VTEDIT editor, saving your current buffer.J VTEDIT will ask you if you want to save each of your other modified buffers.J The Ctrl/Z key invokes this command, as does the F10 key on VT200 series terminals.ww@N- 1 EXPAND_TABS EXPAND TABSJ Expand Tabs to spaces, using the current Tab setting, within the next nJ lines. 8 If n is not given and a range has been selected, expand Tabs within this range.- The "Space" key invokes this command.ww@9N- 1 FILE_SEARCH FILE SEARCHJ Get a (possibly wildcard) filespec from the keyboard and display aJ directory listing of all files matching this filespec. This listing mayG be used to select and read one of the files via the This File command.0 The keypad "7" key invokes this command.ww@nN-1 FILL9 FILLJ FILL reformats a selected region or one or more lines so the text fitsJ between the left and right margins. The cursor moves to the end of the reformatted region.' The P key invokes this command.ww@N-1 FIND FINDJ Searches for an occurence of a string. Press the keypad ENTER or the FINDJ key and then enter the string using the main keyboard. End the string byJ pressing the keypad period (.) or, on VT200 terminals, the DO key.J Pressin:g the ENTER or FIND key twice in a row causes the editor to search% for the previously specified string.J Find is normally case-insensitive; it is case-sensitive if this option isJ selected by typing the G (Set Search Case) command, or if theD search argument contains a case-sensitive pattern (^EV and/or ^EW).7 The keypad ENTER and the FIND key invoke this command.ww@N- 1 FIND_MARK FIND MARKJ If the previous keystroke was a VTEDIT Find or Find Ne;xt command,J return the cursor to its position just before issuing the last command.J Otherwise, jump to the next mark set via the Insert Mark command. ByJ entering the Find Mark command repeatedly, you can cycle through all the marks that you defined.G The FIND and keypad period (.) keys invoke this command.ww@ N- 1 FIND_NEXT FIND NEXTJ Search in the text buffer for the n-th occurence of the search argumentJ which was most recently saved via< any Find command. If n is negative, the( search is done backwards in the buffer.0 The keypad period key (.) invokes this command.ww@BN-1 FIND_PREVIOUS FIND PREVIOUSJ Search backwards in the text buffer for the n-th occurence of the searchB argument which was most recently saved via any Find command.J The keypad period key (.) with a negative numeric argument invokes this command.ww@wN-1 FIND_REVERSE FIND REVERSEJ Searches backward=s for the occurence of a string. End the string byC pressing the keypad period (.) or, on VT200 terminals, the DO key.J Find is normally case-insensitive; it is case-sensitive if this option isJ selected by typing the G (Set Search Case) command, or if theD search argument contains a case-sensitive pattern (^EV and/or ^EW).J The keypad ENTER and the FIND key with a negative numeric argument invoke this command.ww@ O- 1 FORM_FEED FORM FEED@ Insert >a form feed (page break) at the current cursor position.% The Ctrl/L key invokes this command.ww@O- 1 FORMATTER FORMATTERJ Select a formatter type for the current text buffer. Formatters areJ selected according to a file type, so you are prompted with 'FormatterJ name (file type):'. You may enter one of the file types of the following) list (with or without a leading period):D .C .CLD .ENV .H .PAS .TPU --> Structured Language6 .CBL .C VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13l> ?OB .LIB --> Cobol8 .COD .DES .DUM .EXT .FOR .FTN .INC .INT --> Fortran4 .COM .MMS .OPT --> DCL9 .DOC .HLP --> Document? .DTR .LSE .PDM .PEL .VTE --> Query Language6 .MAC .MAR .PPA --> Macro5 .RND .RNH .RNO .RNT .RNX .TXT --> TextJ NOTE: The formatter stays selected for the current buffer until a newJ formatter is selected for th@is buffer. Entry into a new buffer selectsJ the formatter selected for this buffer, or a formatter according to theJ file type of this buffer, if no formatter for this buffer has been selected explicitly.J If VTEDIT is running with LSE support and if the Formatter command isJ given with a negative numeric argument, a new language for the current buffer is selected.0 The keypad "5" key invokes this command.ww@#O- 1 FREE_CURSOR FREE CURSORJ S Aelect free cursor movement. With free cursor movement, the arrow keysJ move the cursor in the direction indicated on the key, regardless of the6 fact whether there is text at the destination or not.) The ">" key invokes this command.ww@K/O-1 GET_NEXT_WORD GET NEXT WORDJ Move the next n words to the current line. If n is positive, the first nJ words of the next line(s) are moved to the end of the current line. If nJ is negative, the last n words of the pBrevious line(s) are moved to the beginning of the current line.' The N key invokes this command.ww@;O-1 HELP HELPJ The HELP key provides Help on the VTEDIT commands. After pressing HELP,J press the key or type the name of the VTEDIT command that you want Help on. Press SPACE to leave Help.J Type ? to see a list of commands. If you wish to obtain Help on VAXTPU,J type TPU, and optionally the name of the VAXTPU item you are interested in.0 TheC H and HELP keys invoke this command.ww@GO-1 INCLUDE_FILE INCLUDE FILEJ The Include File command makes it possible to combine files. The file youJ specify is read from the file system and placed before the current cursorJ position. The cursor moves to the beginning of the inserted file. TheJ file still exists in its original form in the file system after you include it.' The A key invokes this command.ww@SO-1 INCLUDE_REGIST DER INCLUDE REGISTERJ Insert the contents of Q-register q in the text buffer. In this command,J q can be any alphabetic Q-register name, i.e. any letter, or it can beJ either of the special names '*' (file name buffer) and '_' (search stringD buffer). Uppercase and lowercase letters are treated as equivalent.J If a rectangular region has been saved in the selected Q-register, theJ contents of this register are inserted as a rectangle, i.e. they areJ inserted or written over oEld text, according to the current mode (InsertJ or Overstrike) in a rectangle of the same size, whose upper left corner is the current cursor position.J If this command is given with a numeric argument n, the contents of the register are inserted n times.< The Ctrl/G key, followed by a letter, invokes this command.ww@`O-1 INCREASE_INDENT INCREASE INDENTJ Set the value for indentation increment and decrement to 3. This commandJ does not perform any indentatioFn; it simply presets a value for further indentation commands.J The "+" key, if typed at the start of a line, invokes this command, if( the Query Language formatter is active.ww@TlO-1 INDENT INDENTJ Set the indentation of the current line to the current indentation value.J This command is used primarily to reset the indentation of a line to theJ current indentation value. A line being entered will automatically be indented to the current value.J The ". G" key, if typed at the start of a line, invokes this command, if a6 formatter supporting automatic indentation is active.ww@xO-1 INDENT_CONTINUATION INDENT CONTINUATIONJ If the Fortran formatter is active, create the beginning of a FortranJ continuation line by inserting 5 spaces, an "*" and a Tab at theJ beginning of the current line, followed by the appropriate number of tabs7 and spaces to reach the current indentation value + 4.J If the Cobol formatteHr is active, mark the current line as a comment by inserting an "*" in column 7.J The "*" key, if typed at the start of a line, invokes this command, if5 either the Fortran or the Cobol formatter is active.ww@O- 1 INDENT_LESS INDENT LESSJ Decrement the current indentation value by n if n is given, otherwise byJ a formatter dependent value, and set the indentation of the current lineJ to that value. If a range has been selected, decrement the indentation ofJ a Ill lines in that range, but do not change the current indentation value for new lines entered.J The "<" key, if typed at the start of a line, invokes this command, if a6 formatter supporting automatic indentation is active.ww@O- 1 INDENT_MORE INDENT MOREJ Increment the current indentation value by n if n is given, otherwise byJ a formatter dependent value, and set the indentation of the current lineJ to that value. If a range has been selected, increment the indeJntation ofJ all lines in that range, but do not change the current indentation value for new lines entered.J The ">" key, if typed at the start of a line, invokes this command, if a6 formatter supporting automatic indentation is active.ww@(O-1 INSERT_BUFFERNAME INSERT BUFFERNAMEJ Insert the name of the current text buffer at the current cursor position.J The keypad "3" key with a negative numeric argument invokes this command.ww@]O- 1 KINSERT_DATE INSERT DATEH Insert the current date in the format dd-mmm-yyyy into the text buffer.% The Ctrl/] key invokes this command.ww@O-1 INSERT_INFILE INSERT INFILEJ Insert the full file name of the current input file at the current cursor position.J The keypad "1" key with a negative numeric argument invokes this command.ww@O- 1 INSERT_MARK INSERT MARKJ Insert a mark at the current cursor position. You can use this mark toG re-Lposition to the marked position later on via the Find Mark command.J Up to 5 marks may be active at any one time; the sixth mark defined via> the Insert Mark command will delete the first one, and so on.J The INSERT HERE key invokes this command, as does the : keypad comma (,) key if you are not positioned at a mark.ww@O-1 INSERT_NUMERIC INSERT NUMERICJ Accept a character from the terminal and insert into the text buffer theJ string representiMng the ASCII value of that character. If n is present,J insert the string representing n and do not accept an extra character.J VTEDIT inserts the number using the current radix, if the command is given with a numeric argument.% The Ctrl/\ key invokes this command.ww@1O-1 INSERT_OUTFILE INSERT OUTFILEJ Insert the full file name of the output file associated with the current' buffer at the current cursor position.J The keypad "2" key with a negative numex VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13MNric argument invokes this command.ww@fO-1 INSERT_SPECIAL INSERT SPECIALJ Insert at the current cursor position the character whose ASCII value is n.A The keypad "9" key with a numeric argument invokes this command.ww@O- 1 INSERT_TEXT INSERT TEXT8 Insert a string of text at the current cursor position.H This command is used to enter text if VTEDIT is run in /NODISPLAY mode.ww@O- 1 INSERT_TIME INSERT TIMEE Insert the Ocurrent time in the format hh:mm:ss into the text buffer., The Ctrl/] key invokes this command.ww@ P-1 INSERT_WILDCARD INSERT WILDCARDJ Insert the full file name of the next file matching a previously (by FileI Search or Set Wildcard) defined wildcard at the current cursor position.J The keypad "7" key with a negative numeric argument invokes this command.ww@:P-1 ITERATE_REGISTER ITERATE REGISTERJ Compile the TPU command(s) or procedureP in Q-register q and execute them n times.C The Ctrl/E key, followed by a letter, invokes this command.ww@o#P-1 LEARN LEARNJ The Learn command tells VTEDIT to "learn" or record a sequence ofJ keystrokes. This learning process begins when the L key is pressedJ and continues until stopped by a second L. The sequence of learnedA keystrokes is then remembered, and assigned to the X key.' The L key invokes this command.wQw@/P-1 LINE LINE. Move the text pointer to the start of line n.J The keypad "1" key with a positive numeric argument invokes this command.ww@;P- 1 LINE_MODE LINE MODEJ Execute one or more VTEDIT commands in line mode. Each command isJ executed as soon as the RETURN or DO key is pressed. Terminate commandJ entry by typing the command "Continue" or simply by entering an emptyJ command. You may recall previous commands by typing the up Rand down arrow keys.% The Ctrl/Z key invokes this command.ww@HP-1 LINE_MODE_EDITOR LINE MODE EDITORJ The line mode editor is invoked if VTEDIT is started in /NODISPLAY mode.J You may enter any VTEDIT commands that do not make use of windows. EnterJ the commands without leading blanks, and terminate each command with theJ return key. Typing the Exit command or the Ctrl/Z or F10 key terminates VTEDIT in this mode.J Input of an empty line positions to the nex St line in the current bufferJ and displays this line. Any input line not starting with a symbolJ constituent character, or one of the characters @ and !, is used as a$ pattern to change the current line:J - Each non-blank character replaces the corresponding character in the current line.B - Each ] deletes the corresponding character in the current line.; - Each # replaces the corresponding character with blank.J - All characters after the first [ are inserted before tThe corresponding! character in the current line.J The characters #, [, ] may be substituted by specifying one ore more non-J blank characters as the first three characters in the input line; these? characters replace the three control characters in this order.ww@CTP-1 LIST_BUFFERS LIST BUFFERSJ Display a list of all buffers currently used by VTEDIT. The first part ofJ this list contains the user buffers, the second part contains the systemJ buffers. This buffeUr list may be used to select one of the buffers via the This File command.5 The F7 and : keys invoke this command.ww@x`P- 1 LOWERCASE LOWERCASEJ If a range has been selected, change within this range any uppercaseJ letter to lowercase. Otherwise, lowercase any uppercase characters withinJ the next n characters, starting at the current text pointer. If n isJ positive, the command operates toward the end of the buffer, otherwise to the beginniVng.' The V key invokes this command.ww@lP-1 MARK MARKJ Mark the current text buffer pointer position for use with later commandsJ (see individual commands). If you type the keypad 9 key or the SELECT keyJ when a mark has been set, the mark is removed and the bell sounds. Thus,J to remove a mark, type the keypad 9 key or the SELECT key until the bell3 rings. The mark is always removed when it is used.; The keypad "9" key and the SELECT key invoke this comWmand.ww@xP-1 MENU MENUJ Display a list of the VTEDIT command groups and let the user select aJ group. Then, display a list of the commands of this group and let theJ user select a command of this group. This command is mainly intended as aH teaching aid; additionally, it may be useful if invoked with the mouse.' The Y key invokes this command.wwP-1 MOUSE_POSITION MOUSE POSITION= Position the cursor at the location pointed at Xby the mouse.J If this location is in the status line of a window, scroll that window;J clicking the mouse in the left half of the status line scrolls the windowJ down, moving the cursor position towards the top of the file, andJ clicking in the right half scrolls up, moving the cursor towards the end.E Clicking the mouse on an item in a selection menu selects this item.J Clicking the mouse in the last line of the screen displays a menu ofJ VTEDIT command groups. You maYy then select a group from this menu, and,- in a second step, a command from this group., The left mouse button invokes this command.ww@LP-1 MOUSE_SELECT MOUSE SELECTJ Position the cursor at the location pointed at by the mouse and start aJ select range at this location. If the mouse button is released at theJ same location, the select range is created when the mouse button isJ clicked a second time, and it covers the area spanned by the two clicks.J If Zthe mouse is moved before releasing the button, the select rangeJ covers the area spanned by the downstroke and upstroke positions of the mouse.J VTEDIT displays a menu allowing to perform a Cut, Save or RemoveJ operation on the select range. Cutting and Saving moves the text in theJ select range into the paste buffer, and Cutting and Removing deletes it& from its location in the user buffer.. The middle mouse button invokes this command.ww@P- 1 MO[USE_PASTE MOUSE PASTEJ Position the cursor at the location pointed at by the mouse and insert3 the contents of the paste buffer at this location.- The right mouse button invokes this command.ww@P- 1 MOVE_DOWN MOVE DOWNJ Moves the cursor down one line on the screen. If the cursor is near the7 last line of a window, scrolls the window up one line.) The down-arrow key invokes this command.ww@P- 1 MOVE_LEFT MOVE LEFTJ Moves the cur\sor left one column on the screen. If the cursor is on theJ first character of a line, and if bound cursor movement has been) selected, it wraps to the previous line.) The left-arrow key invokes this command.ww@ P- 1 MOVE_RIGHT MOVE RIGHTJ Move the cursor right one column on the screen. If the cursor isJ positioned after the last character of a line, and if bound cursor7 movement has been selected, it wraps to the next line.* The right-a3U VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13' \]rrow key invokes this command.ww@UP- 1 MOVE_UP MOVE UPJ Move the cursor up one line on the screen. If the cursor is near the: first line of a window, scrolls the window down one line.' The up-arrow key invokes this command.ww@P- 1 NEXT_BUFFER NEXT BUFFERJ Position to the next user buffer. If you are currently using one window,J the One Window command will perform this function, too, as will the Two9 Windows command, if you are currently^ using two windows.J The F7 key invokes this command, as do the D or B keys, if+ you have one or two windows, respectively.ww@P- 1 NEXT_LINE NEXT LINEJ Advance the text pointer by n lines, leaving it at the beginning of a line.) The keypad "0" key invokes this command.ww@P- 1 NEXT_PAGE NEXT PAGEJ Go forward n pages in the file being edited. Pages are delimited by form8 feed characters and by start or end of the text b_uffer.) The keypad "8" key invokes this command.ww@)P- 1 NEXT_SCREEN NEXT SCREENJ Next Screen moves the cursor vertically through the file, a screenful ofJ text at a time. The cursor moves forward, filling your screen with the following lines of information.C The down-arrow and the NEXT SCREEN key invoke this command.ww@^ Q- 1 NEXT_WORD NEXT WORDJ Advance the text pointer by n words, leaving it at the first character ofJ the n-th `word. Words are normally delimited by sequences of spaces, tabs,J commas, carriage returns, and line feeds. See the section on selecting word delimiters.% The Ctrl/F key invokes this command.ww@Q- 1 ONE_WINDOW ONE WINDOWJ The One Window command returns the screen to one view of the currentJ buffer. The window the cursor is in becomes the current window. If youJ have been viewing two different documents in the two windows, VTEDITJ removes the other a window from the screen. The contents of the otherJ buffer are not affected; you can return to editing this buffer by usingE the Buffer command, or by (repeatedly) using the One Window command.' The D key invokes this command.wwN%Q-1 OTHER_WINDOW OTHER WINDOWJ The Other Window command allows you to move the cursor from one window toJ the other. Many editing functions are performed at the current locationJ of the cursor, so you may frequently want to bmove it from one window toJ the other. If you want scrolling in a window, for example, you must have the cursor in that window.J If more than two text windows are currently displayed, the Other WindowJ command circles through these windows, i.e. it positions from the topJ window to the next one, and so on, and from the bottom window back to the top window.J If the Other Window command is given with a numeric argument, the valueJ of this argument determines the window to positicon to. Normally, windowsJ are counted from the top of the screen. When using VTEDIT with supportJ for the Language Sensitive Editor, however, the numbers of the windowsJ may depend on the sequence of their creation if there are many windows on the screen.. The C and F8 keys invoke this command.ww1Q-1 PASTE PASTEJ Insert the contents of the paste buffer into the text buffer. If aJ rectangular region has been saved in the paste buffer, the contendts ofJ the paste buffer are inserted as a rectangle, i.e. they are inserted orJ written over old text, according to the current mode (Insert orJ Overstrike) in a rectangle of the same size, whose upper left corner is the current cursor position.J If this command is given with a numeric argument n, the contents of the# paste buffer are inserted n times.) The PF3 keypad key invokes this command.ww=Q-1 PREVIOUS_LINE PREVIOUS LINEJ Back up the etext pointer by n lines, leaving it at the beginning of a line.) The keypad "4" key invokes this command.wwIQ-1 PREVIOUS_PAGE PREVIOUS PAGEJ Go backward n pages in the file being edited. Pages are delimited by form8 feed characters and by start or end of the text buffer.J The F14 key invokes this command, as does the keypad "8" key with a negative argument.ww"VQ-1 PREVIOUS_SCREEN PREVIOUS SCREENJ Previous Screen moves the cursor fvertically through the file, a screenfulJ of text at a time. The cursor moves backward, filling your screen with- the previously entered lines of information.A The up-arrow and the PREV SCREEN key invoke this command.wwWbQ-1 PREVIOUS_WORD PREVIOUS WORDJ Back up the text pointer by n words, leaving it at the first character ofJ the n-th word. Words are normally delimited by sequences of spaces, tabs,J commas, carriage returns, and line feeds. See the sectgion on selecting word delimiters.% The Ctrl/R key invokes this command.wwnQ-1 QUIT QUITJ Quit allows you to leave VTEDIT without creating any new files. You canJ use Quit if you are simply reading a file without modifying it, or if you do not want to save your edits.J If you have made any modifications which have not been saved by using theJ Write File command, VTEDIT will ask you if you really want to stopJ editing. Answering yes leaves the editor; ahnswering no keeps you in theJ editor. This allows you to review the current VTEDIT session beforeJ discarding any changes. You can use the Show and List Buffers commands to& see which buffers have been modified.= The - Ctrl/Z keystroke sequence invokes this command.wwzQ-1 QUOTE QUOTEJ This command adds a character to the buffer. It allows you to add aJ carriage return and other control characters. It also allows you to addJ graphic characters,i such as letters and punctuation marks, that are boundJ to other keys. The next key pressed after the Quote command is insertedJ in the current buffer without any interpretation. Pressing Ctrl/M, forJ example, would insert a carriage return at the current cursor position without opening a new line., The Ctrl/\ key invokes this command.ww@pQ- 1 READ_FILE READ FILEJ Use the Read File command when you wish to start editing another file.J Read File reads j a file from the file system, puts the file in a newJ buffer, and displays the new buffer in the current window. The cursor isJ moved to the beginning of the file. The file still exists in its original form in the file system.J If a modified buffer with the same name as the new file already exists,J Read File will ask you for a buffer name. In some cases you will want aJ new buffer; in other cases you will probably want to use the Buffer8 command to move to a file that is aklready being edited.J If VTEDIT is running with LSE support and if the Read File command isJ given with a negative numeric argument, VTEDIT loads an environment file with the name given.0 The keypad "1" key invokes this command.ww+Q- 1 REFRESH REFRESHJ This command redisplays every character on the screen, eliminating anyJ extraneous characters that may have appeared on the screen and anyJ messages displayed in the message window. The cursor >n>vfk HȠ"b \ i( pO rF! Y{nvZ6qx4=s{BI;ztnoQlJr.H'$(G՘M>~)|G&++:I\[CH&cT)3*p3-"Lm')'2Vr x#?YRܲZ $-i@DH`RZ5'&C\Z K6U.+r.CJ-1V,~M]aW>#@lUF?oQy_x|l8!ljBUFAbg&XP "*dA f +M}-pLV8q qw{1EdUN3>s,/0 h"8~opQ*%m9_b7- ;" d@17|?,H|$MHMi#[fsFT7W!NdFZ2Hv 3z C[RY28u!A>C yJaw7fx#h?Mg6>`C%Ih]HD-#/gp.}H8 ')FvV+{ Y;Mg KLrZNANX*70 #Dro>u&w=CO(X{; 0&fn7?vA~hr}W mbYLz1:ER.l _MCdhn{_W/~(_MgrEW>n :|FpJ/rG81 [~?-Qh{{_;5i34fYgkSPw&3Mjyb];^8vnV?) pgP X: ]86?me+I1\/sZ? mћao*oiaP}0ـo+CEu^?vEbn)%X'Z1XWV0eQq / UtmMEvwBT2^IX A0:] fIޅ~d(h-`tMHM=&9KZ OIIX;QP 7 ;a#VpCXWZ0i"(O5k{SPKw\wj=el) jPz `Ck@8}0'=Px5[d \{@H*S49x'J:x93rS\Egr>+'~VT[KQV ux`fu5%bc~rQI |J ]RPJ8CD?$x(42y m <}DRjK H23!+7r=dY|w?=ehV"jvJiz& (>^ B*% oFJF4FFWBa^;Kt +_C S _N;0*?H\Tfp8|Auw29bi.aYEt3_\ilI+,Mz!,]ZW@B^!#,$p; ~X>AZ@)DU^I OZnjtK:;P 9mFIYyl`i60'=D;Z7*(6d+SPCCcrf1.fTj4 W/IHmMm"8che;N?$dHreM{_ P`8,~<$;'^#sR- QO\ya:cKqW#~j#ejj>d|%IE4E]fAZ_[n,OHqd4L[SjC5vP8PO5Zx@Fviet)7UCmh)!x/e-Kpel.0>P{kHd2m{hq8s-YqI?k.u=(12 &VQZa7| _1!'L X\JJ; G&;oVzr )uNR2x]sfS+3%y gq@.wS];T6݈BP1|)g>G)2?l'id\*[Rm3;E%-xyMw GVrS=-tofy&(i/j{NBkONgPa ,2M,>;E:IO6oPu"W ,y#hxm8|~[b)vYu|%w7rl7%$%rj$.#YEz x2^`h(";OaW@2bAv?sl9?VCPH$'O.//7A(Zh}@0i*u(u_O'?h s'.GC^&p Z_c0 mTkZ^}TO,j5߈uZ`X9#^_z\Zg 0RE'F=9 ]*SEh8f.t|d;FE4 dje4Xk-ZCCC/E/"}g53F ,:ath*-i?/&n)s(.~hJ;${0%8hV)`< Y5` @xu&a1,;y$:y<}73#5'b7*@FJ Cq|'E17{<4h//=ay-4RF\`/ s>*YbhT ZH'QF@ZLT]NHR:h.=#PPJe~Kb5J50&>.{|jwK WR cPQk"w_aqxBs0 &?3$4[]O KQ4FT]MRZN uH*5t-gEw_!:ba&,l HFIwJA(^By,p ]M 'U4>b(Ex;eBS@Y,-V| HcXc,"=W~hob/m6+(Du>BRP)wIZJoh-txUI+/U.R/Ov,$YXkF]Ll9X[ NviXdRghtd* bMx?es, @"QaQ;GF00EKv:6Y;ue H#?B~ju]XEN_A!xxv74.Q@W,L:]%0s'T9p1g8UR'KB"(4W$'o`v>1\5c+NJ WN a[*ze.LSD`zZ"p)9Elx#s!* &\ K3!+8>+{)uxK:W  AaNJbt6DhEulccB]L+`TUTɔ Nx>a`hVf8:i#`b(&bc;ɊHRcleE˝+`(c)1w^4H zFI&>;K#\V3]Y'(Vm@W&-{f7m*p2+c>H01>izkPmcRU&QD#s4E-[l52q='po&&T !h"*i>\D`ND')"i.( r&g?1+2=lpeY5CykTt} iypOe};5TO{SjR~^re,SyH/me Zs$_f%)ByvTUN7 ED?(p>obQ .) s.<=2jo86=IW/ 3D`X/[ZF[ ˜iOS6r`P*9O nN;KHX3:R $J !@+"ERa}dy,,ZW:/ _GN\[ j6E*ڡ#4$PZA`B+"gj*_v9),eoE[-MA<-/7=SF)bF2,* "i3{ZE3 ``MWJI%!0,K4"3lb]z>pMYf:3&uV UXv0pTNaFJyZmxGxTvM&v zSKi+ME Je ^Xrk%5p#x>y" ZmEZ0W%'i' BOХ=P:\bӤ~b~d-h6\J"|aV6n ALC$wTsqK`3TJ}&}Z"}'Ӎ!h-lBTXNY5XgNnIRLi3 2WNr.zke]S70@7[B;0Mh5tv &v i-ErczY__,5Fhqn)_5?&G\tRF  o^hIety9( L[B@9p\oc*{iEHDvEt nUL55',(*RCGUr{e ~N 6cv#UE0gx%MVZbwI#7*/?viP$Ey5J}Wc/XH4LWLoU'EzM0:Q13C]^ ];GYUU&/KhfK+F3-5!qqgS=01B:Y BVExreES$f| NF,_)\%w%o.0A+yfWOGa Kni:d: B?WdHyC/Y'G#$by OYH1kzc%]T12t/ AM#{<)q o4LtCL[j2%sbv@IS>@@J z+{mvmi3d ERf70!pZh'9W/h}]MV!Id'FFa`kN  !w/,t.'0 uvh`hqo}nSb0y:;Qsi?i;Ychz!`On7J`;@}RyKՒxiza$]m2&'&8s(V%}bO2ep'm=97DZJRPsP{:d)_4}e&DV{MVo)rqes/;!;QEzd95.q 4[fW&B z| VAZ"`0r#ATb~g{b E3u;~)hVXG.C=84<]oqc@e%Zgoe5z slNE@'^rQ'|:1[8r!v=~K$Qo@07e% I+&Bb3ydh10C6B{ ncq#2OJ#LU1f2>2,mt' fnu&(gzr@wbUft'z%8I}(L`8'Ds^xD_:*K e_WYE@IzT8X BWt51[n2*q02w}\f{O*%klTyr$}EE/tdn2%;\82wnPYdgD ND+@TKW`CRLkJUVYZ8wg$J ; IPs20 Z0eP2OC-J7AV,4 {;m,-u_>mWCVZ#$0M9Cc G!2ANX FE4h?qB=1XwlK.qfQ  1`_sU&zH&IBoG".5o67#2YO;ion,n\ d*|4dxBQc YGB* UF*hnV1{%$!K=8)4CV" r2?i~8SE`o1M h G?1RQgVUP7j YhB"0W': ]9'i,"",5oq&Rjm ;Cx8l}q26RWQFiOV (JE}%HI~JdS/:WOA]i 7GOL7:"~h_ps< KL<6_M<)B4=W7J$># G-b)%.| (4t`@>19RgiD]y5na! R&(%}R^DQ M? X%s0WQQv'enC~GzpY-!~GD+WvGxbKwv%Z !8k:-D1x0}~?uwQ*YeZJ;"&gDzDPOM)y9*nzoSS3,@j*bnEIEma'(m5R+$NXZPC!\8^G8x_HF nq7MpHHPP H#WUJX gaF[bZ/4~UVF.,Zq19pw22DNNS\L^_^KFDk>~d]dk=Zby ]ViqMA#)`hc 'y'Y^tX$ z^ #I\"Vm#%T3VsnulUt#x%;T(z`pr%lq =&$x(Ff4XGg1X2B]M4c $\@ktH 9sQ _L)W>O1pFI?A"Q|V_?a#Zbps,97h`I%\ d(w zt${q0t&[}:Q`A$4o}Tpb9ls-ryej2EB:`XO]I/ATrpH2=$iSO<=)eq"rBz<|OP".+m$#M oYae 11!KX$lW%1^/M?|A4PK_ we!6kz*h4T[bx1zhg*_]8??yWD+%2+a!DX_P[C HYPUxMJ}cz&O nHjNvYdNtO%7y&5\"NtXcB)nzjq= Om.upk 6Hn1[=K@z"TYt|t IO-(|rNm/,6nC!o|-&xHS<5y|4&(%a60-qbd%&`mLq`tV:HqA&oa)j8,,'0b]FhQ wQK]TZO_\ I2&TML }n 11_-1[op'dxeP a^)rdku7L =t$]"X*kH!dTWGO-Hvga E` B(m#Uy VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13Sklremains in the same location.% The Ctrl/W key invokes this command.ww`Q-1 REMOVE REMOVEJ Removes the text in the select range, which is the highlighted area ofJ text on the screen. See the help entry on the Select command for more! information about select ranges.J If a rectangular region has been selected, remove the text inside thisJ rectangle, and, if the current mode is Overstrike, replace it with blanks.J If no select range and no rmectangular region is active, the RemoveJ command deletes one or more lines, depending on a possible numeric argument given.3 The Ctrl/K and the REMOVE key invoke this command.wwQ- 1 REMOVE_MARK REMOVE MARKJ Remove the mark that you are currently positioned at. To position to aJ mark, use the Find Mark command, and to create a mark at the current' position, use the Insert Mark command.J The REMOVE key invokes this command, as does tnhe keypad0 comma (,) key, if you are positioned at a mark.wwʷQ-1 REPEAT REPEATJ Repeat the next command n times, or invoke it with the numeric argument n.J The key, followed by a number or a numeric expression, invokes this command.wwQ- 1 REPLACE REPLACEJ Search in the text buffer for the next occurrence of the search argumentJ which was most recently saved via any Find command, and replace thisJ string by theo current replacement argument, i.e. the contents of theJ paste buffer. If n is given and nonzero, the command is repeated n times.J If a range has been selected before giving the Replace command,3 replacements are restricted to the selected range.J NOTE: Depending on the number of occurrences found, this command may be quite time consuming.) The PF4 keypad key invokes this command.ww4Q- 1 REPLACE_ALL REPLACE ALLJ Search in the text buffer for all p remaining occurrences of the searchJ argument which was most recently saved via any Find command, and replaceJ every such string by the current replacement argument, i.e. the contents of the paste buffer.J If a range has been selected before giving the Replace All command,3 replacements are restricted to the selected range.J NOTE: Depending on the number of occurrences found, this command may be quite time consuming.0 The PF4 keypad key invokes this command.wqwiQ-1 RESET_INDENT RESET INDENTJ Reset the current indentation value to its minimum (normally 0, for theJ Fortran formatter 6). This command does not perform any indentation; it9 simply presets a value for further indentation commands.J The "=" key, if typed at the start of a line, invokes this command, if a6 formatter supporting automatic indentation is active.wwQ-1 RESET_JOURNAL RESET JOURNALJ Close the current journal file and open a nrew one. This operation is onlyJ allowed if there is currently no non-empty user buffer, as otherwise the0 new journal file would be useless for recovery.B The F key without a numeric argument invokes this command.wwQ- 1 RESTORE RESTOREJ If the previous keystroke was a VTEDIT deletion command, restore theJ deleted text and return the buffer pointer to its former position.J If it was a Replace or Exchange command, restore the replaced text.J Ostherwise, delete the spanned text block. The spanned text is the textJ most recently located or inserted in the text buffer via a Cut, Paste,1 Find, or Include command, or by a restoring "6".J If VTEDIT is used with LSE support, and if the last command was an ExpandJ Token or Erase Placeholder command, Restore reverses the effect of that command.) The keypad "6" key invokes this command.wwR-1 RETURN RETURNJ Inserts a new line before the current cursort position, moving the cursor to the start of the new line.% The RETURN key invokes this command.ww= R-1 SAVE SAVEJ Copy n lines from the text buffer into the VTEDIT paste buffer. If n isJ not given and a range has been selected, copy the text of this range. IfJ a rectangular region has been selected, save the text inside thisJ rectangle. Otherwise, copy one line. VTEDIT moves the text pointer to the end of the copied text.J If you repeatedly type the uPF2 key with no intervening keystrokes, VTEDIT6 appends successive lines of text to the paste buffer.F You can delete the text which was saved by typing the "6" keypad key.) The PF2 keypad key invokes this command.wwrR-1 SAVE_REGISTER SAVE REGISTERJ Copy n lines from the text buffer into Q-register q. In this command, qJ can be any letter. Uppercase and lowercase letters are treated asJ equivalent. If n is not given and a range has been selected, copy v theJ text of this range. If a rectangular region has been selected, save theJ text inside this rectangle. Otherwise, copy one line. VTEDIT moves the, text pointer to the end of the copied text.F You can delete the text which was saved by typing the "6" keypad key.< The Ctrl/P key, followed by a letter, invokes this command.ww%R- 1 SCROLL_DOWN SCROLL DOWNJ Move the text pointer continuously by one line up, updating the screenJ each time the pointer moves. Yowu can stop the motion by typing any key.J The character typed to stop the motion is otherwise ignored. Motion alsoJ stops (and the bell sounds) when the text pointer reaches the beginning of the buffer.0 The keypad "4" key invokes this command.ww1R- 1 SCROLL_UP SCROLL UPJ Move the text pointer continuously by one line down updating the screenJ each time the pointer moves. You can stop the motion by typing any key.J The character typed to stop the moxtion is otherwise ignored. Motion alsoJ stops (and the bell sounds) when the text pointer reaches the end of the buffer.0 The keypad "0" key invokes this command.ww>R-1 SELECT SELECTJ Marks one end of a select range. A select range is a block of text onJ which various operations (such as Remove) can be performed. To create a select range:J 1. Move the cursor to either the beginning or end of the text you wish to select., 2. Press the kyeypad "9" or the SELECT key.5 3. Move the cursor to the opposite end of the text.J You can then press the key to invoke the function to be applied to the select range.J If you start a select range and wish to stop without making any changes,I press the keypad "9" or the SELECT key again to cancel the select range.7 The keypad "9" and the SELECT key invoke this command.wwFJR-1 SELECT_RECTANGULAR SELECT RECTANGULARJ Marks one corner of a rectangular regio zn. A rectangular region is a blockJ of text delimited by horizontal and vertical borders on which variousJ operations (such as Remove) can be performed. To create a rectangular region:J 1. Move the cursor to any corner of the rectangle you wish to define asJ a rectangular region. It does not matter whether you start with theJ upper left and finish with the lower right corner, or vice versa, or< whether you use the other two corners of the rectangle.: 2. Press theO] VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13/z { keypad "9" or the SELECT key.J 3. Move the cursor to the opposite corner of the rectangle you wish to$ define as a rectangular region.J You can then press the key to invoke the function to be applied to the rectangular region.J If you start a rectangular region and wish to stop without making anyJ changes, press the keypad "9" or the SELECT key again to cancel the rectangular region.B The SELECT and keypad "9" keys invoke t|his command.ww{VR- 1 SET_ASK SET ASKJ Let VTEDIT ask for confirmation, even when executing an initializationC file or a command file. (This is the default behaviour of VTEDIT.)/ This command can only be given from line mode.wwbR-1 SET_ASK_DEFAULT SET ASK DEFAULTJ When executing an initialization file or a command file, assume theJ default answer for any confirmation questions. Thus, any questions fromI VTEDIT are avoided, which may} be practical when using VTEDIT from batch./ This command can only be given from line mode.wwnR- 1 SET_ASK_NO SET ASK NOJ When executing an initialization file or a command file, always assumeJ the answer "No" for any confirmation questions. Thus, any questions fromI VTEDIT are avoided, which may be practical when using VTEDIT from batch./ This command can only be given from line mode.ww{R- 1 SET_ASK_YES SET ASK YESJ When executing an~ initialization file or a command file, always assumeJ the answer "Yes" for any confirmation questions. Thus, any questions fromI VTEDIT are avoided, which may be practical when using VTEDIT from batch./ This command can only be given from line mode.wwOR- 1 SET_CASE SET CASEJ For text insertion, alternately enable or disable reading of lower case characters.0 The keypad "-" key invokes this command.wwR-1 SET_CASE_LOWER SET CASE LOWER= For text insertion, enable reading of lower case characters.J The keypad "-" key with a negative numeric argument invokes this command.ww๟R-1 SET_CASE_UPPER SET CASE UPPER> For text insertion, disable reading of lower case characters.J The keypad "-" key with a zero numeric argument invokes this command.wwR- 1 SET_CURSOR SET CURSORJ Set the cursor line is to n. The scope driver will try to keep the cursor on the n-th line of the screen.F The Ctrl/W key with a positive numeric argument invokes this command.ww#R- 1 SET_FLASH SET FLASHJ Enables or disables parenthesis highlighting. If you are using aJ formatter supporting parenthesis highlighting, and if this feature hasJ been enabled, VTEDIT will highlight the matching opening parenthesis inJ the message window whenever a closing parenthesis is typed. This featureJ helps greatly in balancing parentheses in complex expressions and programJ statements. If VTEDIT does not find a matching opening parenthesis withinG the current line or the previous 9 lines, it issues a warning message.J Parenthesis highlighting is enabled by default; it is, however,J suppressed for text parts that VTEDIT recognizes as comments or string( literals enclosed in string delimiters., The Ctrl/F key invokes this command.wwXR-1 SET_FLASH_OFF SET FLASH OFFJ Disables parenthesis highlighting. Parenthesis highlighting is enabled by default.I The Ctrl/F key with a zero numeric argument invokes this command.wwR-1 SET_FLASH_ON SET FLASH ONJ Enables parenthesis highlighting. If you are using a formatter supportingJ parenthesis highlighting, and if this feature has been enabled, VTEDITJ will highlight the matching opening parenthesis in the message window) whenever a closing parenthesis is typed.0 Parenthesis highlighting is enabled by default.J The Ctrl/F key with a negative numeric argument invokes this command.wwR-1 SET_FORMATTER SET FORMATTERJ If any formatter is associated with the current text buffer, its9 operation is disabled if it was enabled, and vice versa.' The E key invokes this command.wwR-1 SET_FORMATTER_OFF SET FORMATTER OFFJ If any formatter is associated with the current text buffer, its operation is disabled.D The E key with a zero numeric argument invokes this command.ww,R-1 SET_FORMATTER_ON SET FORMATTER ONJ If any formatter is associated with the current text buffer, itsJ operation is enabled. Formatters are enabled by default; you need this: command only if a formatter has been disabled explicitly.H The E key with a negative numeric argument invokes this command.wwaS- 1 SET_JOURNAL SET JOURNALJ I f used without a numeric argument, close the current journal file andJ open a new one. This operation is only allowed if there is currently noJ non-empty user buffer, as otherwise the new journal file would be useless for recovery.J If used with a positive numeric argument n, change the frequency withJ which VAXTPU logs your typing into the journal file. The lower theJ (positive) value of n is, the more often VAXTPU writes a record to theJ log file. A value of 1 causes a record to be written for approximatelyJ every 10 - 30 keys pressed; a value of 10 or more causes a record to be@ written for every 120 - 300 keys pressed, which is the default.' The F key invokes this command.ww S-1 SET_LEFT_MARGIN SET LEFT MARGINJ This command changes the left margin for the current buffer. The rightJ margin is not changed. If n is given, set the left margin to that value,1 otherwise set it to the current cursor position.J The le ft margin is set to 0 by default. You can use the Show command to5 examine the current margin settings for each buffer.' The M key invokes this command.wwS- 1 SET_MATCH SET MATCHJ Enables or disables automatic closing parentheses. If you are using aJ formatter supporting automatic closing parentheses, and if this featureJ has been enabled, VTEDIT will automatically insert a matching closingJ parenthesis whenever an opening parenthesis is typed. The cursor will beJ positioned between the two parentheses to allow you to insert the parenthesised text.J Automatic closing parentheses are disabled by default; to use thisJ feature, you must explicitly enable them. Automatic parenthesis insertionJ is suppressed for text parts that VTEDIT recognizes as comments or string( literals enclosed in string delimiters., The Ctrl/R key invokes this command.ww&S-1 SET_MATCH_OFF SET MATCH OFFJ Disables automatic closing parentheses. Automatic closing parentheses areJ disabled by default; to use this feature, you must explicitly enable them.I The Ctrl/R key with a zero numeric argument invokes this command.ww52S-1 SET_MATCH_ON SET MATCH ONJ Enables automatic closing parentheses. If you are using a formatterJ supporting automatic closing parentheses, and if this feature has beenJ enabled, VTEDIT will automatically insert a matching closing paren$p VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13JthesisJ whenever an opening parenthesis is typed. The cursor will be positionedJ between the two parentheses to allow you to insert the parenthesised text.J Automatic closing parentheses are disabled by default; to use this* feature, you must explicitly enable them.J The Ctrl/R key with a negative numeric argument invokes this command.wwj>S- 1 SET_MODE SET MODEJ Set Mode changes the current mode of the buffer. The current mode isJ displayed on the status line at the bottom of the window and may be either Insert or Overstrike.J In Insert mode, typed characters are inserted to the left of the currentJ position. In Overstrike mode, typing a character replaces the characterJ at the current position. The DELETE key in Overstrike mode replaces the; character before the current cursor position with a space.) The keypad "-" key invokes this command.wwJS-1 SET_MODE_INSERT SET MODE INSERT J Set Mode Insert sets the current mode of the buffer to Insert. In InsertI mode, typed characters are inserted to the left of the current position.J The keypad "-" key with a negative numeric argument invokes this command.wwVS-1 SET_MODE_OVERSTRIKE SET MODE OVERSTRIKEJ Set Mode sets the current mode of the buffer to Overstrike. In OverstrikeJ mode, typing a character replaces the character at the current position.J The DELETE key replaces the character before the current cursor position with a space.F The keypad "-" key with a zero numeric argument invokes this command.ww cS- 1 SET_MODIFY SET MODIFY= Alternately set the current buffer to be modifiable, or not., The Ctrl/T key invokes this command.ww>oS-1 SET_MODIFY_OFF SET MODIFY OFF+ Set the current buffer to be unmodifiable.I The Ctrl/T with a zero numeric argument key invokes this command.wws{S-1 SET_MODIFY_ON SET MODIFY ON) Set the current buffer to be modifiable.J The Ctrl/T key with a negative numeric argument invokes this command.wwਇS-1 SET_NOVERIFY SET NOVERIFYJ Lets VTEDIT display the effects of executing a command file only after processing the whole file.J This command re-establishes the default behaviour of VTEDIT after giving a Set Verify command./ This command can only be given from line mode.wwݓS-1 SET_ RIGHT_MARGIN SET RIGHT MARGINJ This command changes the right margin for the current buffer. The leftJ margin is not changed. If n is given, set the left margin to that value, otherwise set it to 80.J If a formatter with automatic word wrap (Text or Document) is active, newJ words extending beyond the right margin will be wrapped around to theJ next line. Using the Fill command will reformat the paragraph between the left and right margins.J The right margin is set to 80 by default, or, if VTEDIT is running withJ LSE support, to a language specific value. You can use the Show command8 to examine the current margin settings for each buffer.= The Ctrl/V key with a numeric argument invokes this command.wwS- 1 SET_SCROLL SET SCROLLJ This command controls the scrolling behaviour of the currently visibleJ text windows. In normal mode (the default), the cursor is free to move up( to 3 lines towards any window boundary.J If specified without a numeric argument, this command will switch theJ text windows back and forth between their default behaviour and a mode ofJ scrolling where they scroll only when the cursor position would have beenJ off the current window. For example, a Next Line from the last line on aJ window or a Previous Line from the top line on a window will cause thatJ window to scroll, and it scrolls at once enough lines to position theJ cursor into the middle of the window. This mode is usef ul for for. operation over low speed communication lines.J If specified with a positive numeric argument, VTEDIT attempts to keepJ the cursor positioned that many lines from either window boundary.J window. If the cursor is about to leave this central region of a window,J the window scrolls at once by n lines to make room for further cursorJ movement. If specified with the numeric argument 0, VTEDIT attempts toJ keep the cursor two thirds from the bottom lines of the windows . Any NextJ or Previous Line command will scroll the current window one line thus@ keeping the cursor in the same physical location on the screen.J If specified with a negative numeric argument, the default scrollingJ behaviour of the text windows is re-established, that is, the cursor isJ free to move up to 3 lines towards any window boundary, and the windowsA scroll by one line, if the cursor is about to leave this region., The Ctrl/V key invokes this command.ww GS-1 SET_SCROLL_OFF SET SCROLL OFFJ This command sets the scrolling behaviour of the currently visible textJ windows to a mode of scrolling where they scroll only when the cursorJ position would have been off the current window. For example, a Next LineJ from the last line on the window or a Previous Line from the top line onJ the window will cause the current window to scroll, and it scrolls atJ once enough lines to position the cursor into the middle of the window.J This mode is useful for for operation over low speed communication lines.J The Ctrl/V key invokes this command if scrolling was on, which is the default.ww|S-1 SET_SCROLL_ON SET SCROLL ONJ This command restores the default scrolling behaviour of the currentlyJ visible text windows where the cursor is free to move up to 3 linesJ towards any window boundary, and the windows scroll by one line, if the& cursor is about to leave this region.J The Ctrl/V key invokes this command if scrolling was switched off.wwS-1 SET_SEARCH_CASE SET SEARCH CASEJ Toggle VTEDIT's search mode flag for case-sensitive search. With case-J sensitive search, any further searches will succeed only if the textJ argument is identical to the text in the text buffer. With case-J insensitive search, the text argument in a search command will match textJ in the text buffer independent of case in either the search argument orJ the text buffer. Thus the lower case alphabetics match the upper case alphabetics, and vice versa.J NOTE: Initially, searches are case-insensitive. If the search argumentJ contains a case-sensitive pattern (^EV and/or ^EW), searches are always case-sensitive.' The G key invokes this command.wwS-1 SET_SEARCH_CASE_ANY SET SEARCH CASE ANYJ Set VTEDIT's search mode flag for case-insensitive search. With case-J insensitive search, the text argument in a search command will match textJ in the text buffer independent of case in either the search argument orJ the text buffer. Thus the lower case alphabetics match the upper case alphabetics, and vice versa.J NOTE: Initially, searches are case-insensitive. If the search argumentJ contains a case-sensitive pattern (^EV and/or ^EW), searches are always case-sensitive.D The G key with a zero numeric argument invokes this command.wwS-r VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13 1 SET_SEARCH_CASE_EXACT SET SEARCH CASE EXACTJ Set VTEDIT's search mode flag for case-sensitive search. With case-J sensitive search, any further searches will succeed only if the text6 argument is identical to the text in the text buffer.3 NOTE: Initially, searches are case-insensitive.H The G key with a negative numeric argument invokes this command.wwPS-1 SET_SEARCH_ORIGIN SET SEARCH ORIGINJ Toggle VTEDIT's search mode flag for preservation of the current positionJ on failing searches. Whenever a search fails, the original location ofJ the text buffer pointer will either be preserved, or will be set to 0,D that is the position before the first character in the text buffer.J NOTE: Initially, failing unbounded searches preserve the current position.' The K key invokes this command.wwS-1 SET_SEARCH_ORIGIN_TOP SET SEARCH ORIGIN TOPJ Set VTEDIT's search mode flag such that whenever a search fails, theJ original location of the text buffer pointer will be set to the position/ before the first character in the text buffer.J NOTE: Initially, failing unbounded searches preserve the current position.H The K key with a negative numeric argument invokes this command.wwT-1 SET_SEARCH_ORIGIN SET SEARCH ORIGINJ Set VTEDIT's search mode flag such that whenever a search fails, the@ original location of the text buffer pointer will be preserved.D The K key with a zero numeric argument invokes this command.ww T- 1 SET_TABS SET TABSJ Set Tabs allows you to set tab stops at specified positions or at equalJ intervals. If n is positive, set an additional tab stop at column n; if nJ is negative, set tab stops every n characters. If n is zero, remove allA tab stops, and if n is not given, set tab stops every 8 columns.J On any terminals or printers which have different tab settings from thoseJ specified, the file will not appear the same as it does when viewed usingJ VTEDIT. This command does not affect the hardware tab settings of your terminal.' The R key invokes this command.ww$T- 1 SET_TABS_AT SET TABS ATJ Set Tabs At allows you to set tab stops at the specified columns;J separate the tab positions with blanks, and list the positions in increasing order.J On any terminals or printers which have different tab settings from thoseJ specified, the file will not appear the same as it does when viewed usingJ VTEDIT. This command does not affect the hardware tab settings of your terminal.H The R key with a positive numeric argument invokes this command.wwY&T-1 SET_TABS_EVERY SET TABS EVERY? Set Tabs Every allows you to set tab stops every n characters.J On any terminals or printers which have different tab settings from thoseJ specified, the file will not appear the same as it does when viewed usingJ VTEDIT. This command does not affect the hardware tab settings of your terminal.H The R key with a negative numeric argument invokes this command.ww2T- 1 SET_VERIFY SET VERIFYJ Lets VTEDIT display the effects of executing a command file immediately,J i.e. after executing each command line. Additionally, the commands are7 displayed in the message window, as they are executed.J The effects of the Set Verify command can be reversed with the Set/ Noverify command; Set Noverify is the default./ This command can only be given from line mode.ww>T-1 SET_WILDCARD SET WILDCARDJ Set up a wildcard file search as the basis for subsequent filenameJ lookup matching this filespec with the This File and Insert WildcardJ commands. This command is only a preset; it does not open, close, or try to find any file.F The keypad "7" key with a zero numeric argument invokes this command.wwJT-1 SET_WORD_DELIMITERS SET WORD DELIMITERSJ Several of the VTEDIT editing commands use the idea of a 'word' in theJ text buffer. Normally, words are delimited by sequences of spaces, tabs,J commas, carriage returns, and line feeds. If you have a special editingJ application, you may require a different definition of a word. This. command allows you to change that definition.' The T key invokes this command.ww-WT]SET_SEARCH_CASE_EXACTPSET_SEARCH_ORIGINSET_SEARCH_ORIGIN_TOPpSET_TABS SET_TABS_ATSET_TABS_EVERY SET_VERIFY SET_WILDCARDSET_WORD_DELIMITERS SET_WRITE SET_WRITE_OFF SET_WRITE_ON SHIFT_LEFT SHIFT_RIGHTSHOW SKIP_RANGESORTXSPACESPAWN SPLIT_LINESTANDARD_DELIMITERS START_OF_LINE STORE_NUMBER SUBSTITUTETAB THIS_FILE TOGGLE_MARK- 1 SET_WRITE SET WRITE@ Alternately set the current buffer to read-only, or read/write., The Ctrl/W key invokes this command.wwbcT-1 SET_WRITE_OFF SET WRITE OFFJ Set the current buffer to read-only. If the buffer has been modified,2 VTEDIT warns you that you may loose your changes.I The Ctrl/W key with a zero numeric argument invokes this command.wwoT-1 SET_WRITE_ON SET WRITE ONJ Set the current buffer to read/write. This command is disabled if VTEDIT+ was started with the qualifier /READ_ONLY.J The Ctrl/W key with a negative numeric argument invokes this command.ww{T- 1 SHIFT_LEFT SHIFT LEFTJ Shift Left shifts or moves the window horizontally to the left by theJ number of columns you specify. You can use Shift Left to see beyond theJ width of the screen. For example, suppose that you are editing a fileJ with lines 160 characters long, and you have Set Right Margin to 132. YouF can shift left by 28 to see the characters in columns 29 through 160.J You can use the Show command to see how many columns over the current window is shifted.0 The left-arrow key invokes this command.wwT- 1 SHIFT_RIGHT SHIFT RIGHTJ Shift Right shifts or moves the window horizontally to the right by theJ number of columns you specify. Shift Right allows you to view charactersJ located to the left of the current screen width. You can use Shift Right0 to reverse the results of a Shift Left command.J You can use the Show command to see how many columns over the current window is shifted.1 The right-arrow key invokes this command.ww6T-1 SHOW SHOWJ Show information about the current editing environment, including theJ name of the input file, the name of the output file, margin settings, and tab settings.J Show will ask you for more information. You may then ent er one of theJ following keywords (or an abbreviation thereof) to obtain general information:: BUFFERS KEYWORDS LISTS MAPS PROCEDURES7 SCREEN SUMMARY VARIABLES WINDOWS@ or the name of a TPU variable for information on that variable.J If VTEDIT is installed with support for the Language-Sensitive Editor VAXJ LSE, you may also enter one of the following keywords (or an abbreviation> thereof) to obtain information about the current envi VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;139ronment:6 ALIAS LANGUAGES MODULES PACKAGES PARAMETERS= PLACEHOLDERS ROUTINES SOURCE_DIRECTORY TOKENS! Press any key to resume editing.J The BACKSPACE, F12, Ctrl/H and HELP keys invoke this command.wwkT- 1 SKIP_RANGE SKIP RANGEJ Back up the text pointer the correct number of characters, and positionJ it to where it was prior to the last operation. For example, if you haveJ just saved some text with the PF2 keypad key, then this would re-position$ you to the start of the saved text.0 The keypad "6" key invokes this command.wwࠬT-1 SORT SORTJ Sort the lines of the selected range in lexically ascending order. If aJ rectangular region has been selected, sort the lines of text of thatJ region using the columns inside the region as sort key. If no range orJ region has been selected but a numeric argument has been given, sort the2 next n lines; otherwise, sort the current buffer., The Ctrl/K key invokes this command.wwոT-1 SPACE SPACEJ The Space command inserts or overstrikes a space character at the current0 cursor position, depending on the current mode.J Space also will move the cursor to the start of the next line if theJ cursor is beyond the right margin, if a formatter with automatic wordJ wrap (Document or Text) is active. If the current word extends beyond theJ right margin and automatic word wrap is in effect, that word will also be moved to the next line.J You can change the current margin settings by using the Set Left Margin and Set Right Margin commands.$ The SPACE bar invokes this command.ww T-1 SPAWN SPAWNJ Suspend the current VTEDIT editing session and connect the terminal to aJ new DCL subprocess. Logging out of the DCL subprocess or executing anJ appropriate ATTACH command from DCL level from this subprocess resumes the VTEDIT editing session.J The Spawn command can be used to run screen-oriented programs and DCL7 utilities without losing your current editing session./ The S and F19 keys invoke this command.ww?T- 1 SPLIT_LINE SPLIT LINEJ Insert n return/line feed sequences after the current text pointer. TheJ effect of this command is to move the rest of the text on the current line down by n lines.) The keypad "7" key invokes this command.wwtT-1 STANDARD_DELIMITERS STANDARD DELIMITERSJ Restore the set of word delimiters to the standard set: space, Tab,# comma, carriage return, line feed.D The T key, without a numeric argument, invokes this command.wwT-1 START_OF_LINE START OF LINE@ This command moves the cursor to the start of the current line.) The keypad "3" key invokes this command.wwT-1 STORE_NUMBER STORE NUMBERJ Save the numeric value of n in the numeric part of Q-register q. In this command, q can be any letter.J The U key (with a numeric argument), followed by a letter, invokes this command.wwU- 1 SUBSTITUTE SUBSTITUTEJ Get a replacement argument from the keyboard and put it in the paste@ buffer, then replace the string just searched by this argument.I The keypad ENTER key and the INSERT HERE key invoke this command.wwHU-1 TAB TABJ Inserts a tab character at the current cursor position. The tab characterJ is inserted regardless of whether the buffer is in Insert or Overstrike mode." The Tab key invokes this command.ww}U- 1 THIS_FILE THIS FILEJ Read the file pointed at by the cursor in a directory listing produced byJ the File Search command, or move to the buffer pointed at by the cursor7 in a buffer list produced by the List Buffers command.J In the first case, This File reads that file from the file system, pu tsJ the file in a new buffer, and displays the new buffer in the currentJ window. The cursor is moved to the beginning of the file. The file still0 exists in its original form in the file system.J If the cursor is positioned on a buffer name in a buffer list produced byJ the List Buffers command, This File displays that buffer in the currentJ window. This command provides an easy method for positioning to a system buffer.J If the cursor is positioned neither on a directory listing nor on aJ buffer list, but a current wildcard has been established via a FileJ Search command, This File reads - after asking for confirmation - the& next file according to this wildcard.2 The keypad "PF3" key invokes this command.ww&U- 1 TOGGLE_MARK TOGGLE MARKJ Insert a mark at the current cursor position, or, if you are alreadyJ positioned at a mark, remove it. You can use the mark you inserted toG re-position to the marked position later on via the Find Mark command.6 The keypad comma (,) key invokes this command.ww2U-1 TOP TOPJ Move the text pointer to the start of line n. If n is not given but aJ range or rectangular region has been selected, jump across that range or= region. Otherwise, jump to the beginning of the text buffer.) The keypad "1" key invokes this command.ww?U-1 TPU TPUJ The TPU command lets you execute a VAX Text Processing Utility  SPLIT_LINESTANDARD_DELIMITERS START_OF_LINE STORE_NUMBER SUBSTITUTETAB THIS_FILE TOGGLE_MARKlTOPTPUp TRIM_TRAILINGv TWO_WINDOWS TYPETYPINGUMLAUTUNKNOWNd UPPERCASE(VTE_COMMAND_LISTVTE_LSE_KEYPADVTE_LSE_KEY_LIST> VTE_LSE_LISTVTE_VT100_KEYPADVTE_VT200_KEYPADVTE_VTE_KEYPAD  WHAT_LINEp WRITE_FILE WRITE_RANGEcommand. For example, message ('Hello')J compiles and executes the VAXTPU command, "message ('hello')". The word' "Hello" appears in the message window.J The VAX Text Processing Utility Reference Manual contains complete' information about the VAXTPU language.; The Ctrl/? and DO keys invoke this command.wwQKU-1 TRIM_TRAILING TRIM TRAILINGJ Delete trailing blanks within the next n lines. If n is not given and aC range has been selected, delete trailing blanks within this range.. The "Return" key invokes this command.wwWU- 1 TWO_WINDOWS TWO WINDOWSJ The Two Windows command creates two sections on the screen, making itJ possible to view different parts of one file, or two different documents.J When you view one file in two windows, whatever you do to one is done toJ the other. This is not true when viewing two different files in two windows.J If there is one win dow on the screen, Two Windows takes the currentJ window and divides it into two smaller windows. The current buffer isJ displayed in both windows, and the cursor is moved to the bottom window.J To view two different files at the same time, use the Buffer or Read FileJ commands after using Two Windows to put a new buffer or file in theJ current window, or circle through the available buffers by repeatedly using the Two Window command.' The B key invokes this command.g- VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13]5wwcU-1 TYPE TYPEJ Type the next n lines, beginning at the current cursor position. If n isJ not given, type the current line. If n is zero or negative, type n linesJ preceding the current cursor position. If a range has been selected, type the contents of this range.J This command is used to display text if VTEDIT is run in /NODISPLAY mode.wwoU-1 TYPING TYPING KEYSJ In Insert mode, typed characters are inserted to the left of the currentJ cursor position. In Overstrike mode, typing a character replaces the* character at the current cursor position.ww%|U- 1 UNKNOWN UNDEFINED KEYB The key that you have pressed has not been assigned to a command.wwZU-1 UMLAUT UMLAUTJ Insert an umlaut character of the supplemental (multinational) characterJ set at the current position. The character to be inserted is selected viaJ the character 'x' typed after the quote, according to the following rules:1 a --> o --> u --> 1 A --> O --> U --> ' s --> J This command is useful for entering German texts from a VT100 terminal6 not supporting the eightbit multinational ASCII code.' The " key invokes this command.wwU- 1 UPPERCASE UPPERCASEJ If a range has been selected, change within this range any lowercaseJ letter to uppercase. Otherwise, uppercase any lowercase characters withinJ the next n characters, starting at the current text pointer. If n isJ positive, the command operates toward the end of the buffer, otherwise to the beginning.' The W key invokes this command.wwĠU- 1 WHAT_LINE WHAT LINEJ Show the current line number, total number of lines in the buffer, andJ percentage of that position in the buffer. This is useful if you want toJ know whether to insert a page break or simply to find out how many lines are in the buffer., The Ctrl/N key invokes this command.wwU- 1 WRITE_FILE WRITE FILEJ The Write File command places the contents of the current buffer in theJ file you specify. The editing session does not end until you use either the Exit or Quit commands.J The Write File command does not change the buffer name, but it allows toJ change the output file name. A future Write File command will write theJ buffer to the new file name (as will the Exit command, if the buffer hasJ been modified). You can examine the current output file name with the Show command.0 The keypad "2" key invokes this command.ww.U- 1 WRITE_RANGE WRITE RANGE) Write a range of text to an output file.J VTEDIT writes n lines of text to an output file, starting at the currentJ text pointer (the character under the cursor). If n is not given but aJ mark is set, VTEDIT writes the text between t he mark and the current textJ pointer, otherwise, VTEDIT writes one line. VTEDIT moves the text pointerJ to the end of the text written. You can delete the text which was written by typing the "6" keypad key.0 The PF2 keypad key invokes this command.wwU-1 VTE_VT100_KEYPADT lqqqqqqqqwqqqqqqqqwqqqqqqqqwqqqqqqqqk lqqqqqqqqwqqqqqqqqwqqqqqqqqwqqqqqqqqk` x ^ x x x x x x x Save x Paste xSearch/`xd x x x v x x x Gold xText *`ax Text *axReplace*x~ x Up * x Down * x Left * x Right* x x xWrite *`xGet Filex All ` xw x Screen*x Screen*x Shift* x Shift* x tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqquY mqqqqqqqqvqqqqqqqqvqqqqqqqqvqqqqqqqqj x Open x Page * xSelect /x Insert/xY x Line x x Quote* xOverstr*xy All (*) commands take an optional numeric xWildcardx Output xSel.RectxRead LowxU argument of the following form: tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqqud  Gold [-]  x Up x Delete x Delete/x Replacex[ x Line * x Char * x Restorex Found x{ All (`) commands operate on selected  xContin. x Format x Skip x[Un]MarkxW ranges, all (a) commands on rectangular tqqqqqqqqnqqqqqqqqnqqqqqqqqnqqqqqqqqu] regions. x Top x Bottom x Start x Enter xi All shaded commands are prefixed by Gold. x/Jump*`ax x of Linex Search xp xOpen InpxOpen Outx Buffer x Argum *xU Delete Rubout character tqqq qqqqqvqqqqqqqqnqqqqqqqqu xb Backspace End of line x Down Line * x Search x Enter x` Ctrl/Z Execute TPU command(s) x x Again *x Replacexw Ctrl/Z Exit and close file xDown Continuouslyx Goto xArgumentx]  -  Ctrl/Z Kill output and exit mqqqqqqqqqqqqqqqqqvqqqqqqqqvqqqqqqqqjwwU-1 VTE_VT200_KEYPADN lqqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqqkN x "F6" x "F7" x "F8" x "F9" x "F10" xX x Cancel x Next Buffer xOther Window*xChange Wind.*x Exit xs x x List Buffersx x x xN tqqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqqj? x "F11" x "F12" x "F13" x "F14" xG  xCompile TPU *`x End of Line x Line Feed x Page Back * x_ xExecute TPU *`x Show Status x x x ? mqqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqjN lqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqk lqqqqqqqqqqqqwqqqqqqqqqqqqqqkX x "Find" x"Insert Here"x "Remove" x x "Help" x "Do" xX xSearch Argum*xReplace Argumx Delete *`a x x Get Help xVTEDIT Comm. *x{ x Go to Mark x Insert Mark x Remove Mark x xShow Status x TPU Command xN tqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqu mqqqqqqqqqqqqvqqqqqqqqqqqqqqj6 x "Select" x"Prev Screen"x"Next Screen"x= xSelectRectangxBack Screen *xAdvance Scr.*x0 mqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqj@ lqqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqk ? x "F17" x "F18" x "F19" x "F20" xG x Attach x DCL Command x Spawn x Compile x? mqqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqjwwU-1 VTE_LSE_KEYPADN lqqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqqkN x "F6" x "F7" x "F8" x "F9" x "F10" xX x Cancel x Next Buffer xOther Window*xChange Wind.*x Exit xw x x List BuffersxGoto Declar*`xFind%t VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13 Symbol*`x xN tqqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqqj? x "F11" x "F12" x "F13" x "F14" xG xCompile TPU *`x End of Line x Expand x Page Back * xc xExecute TPU *`x Show Status x LSE Keys * x Review x N tqqqqqqqqqqqqqwvqqqqqqqqqqqqwvqqqqqqqqqqqqwvwqqqqqqqqqqqqnqqqqqqqqqqqqqqkX x "Find" x"Insert Here"x "Remove" x x "Help" x "Do" xX xSearch Argum*xReplace Argumx Delete *`a x x Get Help x LSE Command x{ x Go to Mark x Insert Mark x Remove Mark x xShow Status x TPU Command xN tqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqu mqqqqqqqqqqqqvqqqqqqqqqqqqqqjQ x "Select" x"Prev Screen"x"Next Screen"x Ctrl/A Define AliasS x Select xBack Screen *xAdvance Scr.*x  ?  Help /Languaged xSel. Rectang.xPrevPlacehld*xNextPlacehld*x Ctrl/? LSE command input? tqqqqqqqqqqqqqvwqqqqqqqqqqqqvwqqqqqqqqqqqqvwqqqqqqqqqqqqqk? x "F17" x "F18" x "F19" x "F20" xG x Attach x DCL Command x Spawn x Compile xc xErase Placehldx Goto Source x Prev. Step *x Next Step *x ? mqqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqjwwU-1 VTE_VTE_KEYPADN  lqqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqwqqqqqqqqqqqqqqkN x "F6" x "F7" x "F8" x "F9" x "F10" xX x Cancel x Next Buffer xOther Window*xChange Wind.*x Exit xw x x List BuffersxGoto Declar*`xFind Symbol*`x xN tqqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqqj? x "F11" x "F12" x "F13" x "F14" xG xCompile TPU *`x End of Line x Expand x Page Back * xc xExecute TPU *`x Show Status x LSE Keys * x Review x N tqqqqqqqqqqqqqwvqqqqqqqqqqqqwvqqqqqqqqqqqqwvwqqqqqqqqqqqqnqqqqqqqqqqqqqqkX x "Find" x"Insert Here"x "Remove" x x "Help" x "Do" xX xSearch Argum*xReplace Argumx Delete *`a x x Get Help xVTEDIT Comm. *x{ x Go to Mark x Insert Mark x Remove Mark x xShow Status x TPU Command xN tqqqqqqqqqqqqqnqqqqqqqqqqqqqnqqqqqqqqqqqqqu mqqqqqqqqqqqqvqqqqqqqqqqqqqqjQ x "Select" x"Prev Screen"x"Next Screen"x Ctrl/A Define AliasS x Select xBack Screen *xAdvance Scr.*x  ?  Help /Languaged xSel. Rectang.xPrevPlacehld*xNextPlacehld*x Ctrl/? LSE command input? tqqqqqqqqqqqqqvwqqqqqqqqqqqqvwqqqqqqqqqqqqvwqqqqqqqqqqqqqk? x "F17" x "F18" x "F19" x "F20" xG x Attach x DCL Command x Spawn x Compile xc xErase Placehldx Goto Source x Prev. Step *x Next Step *x ? mqqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqvqqqqqqqqqqqqqjww7U-1 VTE_COMMAND_LISTP  in the following command list stands for typing the Gold key.8 Moving the Cursor< Jump to Top/Line n/Selection *`a "1": Jump to End of Buffer "2": Advance Line * "0": Back Line * "4": Start of Line "3"S End of Line "Backsp." or "F12" or Ctrl/H; Advance Character * "->"; Back Character * "<-": Down in Column  * "^": Up in Column * "v"= Advance Word * Ctrl/F= Back Word * Ctrl/RB Advance Continuously "0"B Back Continuously "4"S Advance Screen Image * "v" or "Next Screen"S Back Screen Image * [ m"^" or "Prev Screen": Advance Page * "8"S Back Page * "F14" (or "8" with arg. < 0)B Skip Over Last Operation "6"I Find Remembered Position from Previous Run -F@ Marking and Retrieving PositionsF Start Selection "9" or "Select"V Select Corner of Rectangular Region "9" or "Select": Jump to Start of Selection "1"[ Insert Permanent Mark "," or "Insert Here"V Remove Permanent Mark "," or "Remove"B Insert/Remove Permanent Mark ","T Go to (next) Mark "." or "Find"4 PromptingP Terminate P rompts via the keypad key "." or, on VT200 terminals, via the "Do"K key. Prompts for file and buffer names are also terminated by "Return". Reject Prompting by Ctrl/Z.6 Searching TextH Set Search Argument and Search Text Buffer * "Enter" or "Find": Search Again * "."? Search and Count Occurrences *` Ctrl/N5 Match Control CharactersM Searc h strings may contain match control characters and/or string buildingI characters allowing the specification of more general search criteria: ^M newline% ^X any character, ^S any non-alphanumeric< ^N x any character except x> ^E n x n occurences of x. ^E A any letter A...Z a...z, ^E B any non-alphanumeric: ^E C any symbol constituent A...Z $ . _' ^E D any digit 0...9V ^E E x exactly the character x (without interpretation)C ^E G q any character in Q-register q: ^E L any line terminator 7 ^E M x any sequence of x? ^E N any supplemental (multinational) letterD ^E P any TPU pattern (delimited by a second ^E P)B ^E Q q the contents of Q-register q: ^E R any alphanumeric A...Z a...z 0...98 ^E S any sequence of blanks and 2 ^E T any sequence of charactersW ^E U q the ASCII character whose code is in Q-register q2 ^E V any lowercase letter a...z2 ^E W any uppercase letter A...Z% ^E X any characterX ^E [x...y] anyoH VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13dF ne of the characters from x to yA The following constructs may be used in replacement arguments: ^M newlineV ^E E x exactly the character x (without interpretation)B ^E Q q the contents of Q-register q[ ^E n the string found for the n-th match control construct; Controlling Searches@ Toggle Case-Sensitivity of Search es GI Set Search to be Case-Sensitive -GI Set Search to be Case-Insensitive 0G@ Toggle Resulting Position on Failing Searches KI Preserve Position on Failing Searches 0KI Jump to Top on Failing Searches -K8 Replacing TextW Set Replacement Argument and Replace Stri ng "Enter" or "Insert Here" just Searched: Replace String just Searched ","> Search and Replace String *` "PF4"F Search and Replace all Occurrences of a String ` "PF4"= Inserting and Moving TextN Insert Text any printing characters> Insert Space * "Space"F Insert Tab  "Tab" or Ctrl/II Insert Newline * "Return" or Ctrl/M: Open Line * "7"N Get Contents of Q-register q * a Ctrl/GqN Save to Q-register q *`a Ctrl/PqO Save and Append to Q-register q *`a Ctrl/P:qN Cut to Q-register q *`a Ctrl/TqO Cut and Append to Q-register q *`a Ctrl/T:q> Save Text *`a "PF2"> Paste Text * a "PF3"T Insert next Character x Ctrl/\xL Insert ASCII Value of Character x Ctrl/\xK Insert Numeric Value of Argument n # Ctrl/\A Insert Special Character #  "9"= Insert Page Break Ctrl/LR Insert Umlaut (||||||) " and a|o|u|A|O|U|s= Insert Date Ctrl/]E Insert Time Ctrl/]C Insert Input File Name -"1"C Insert Output File Name -"2"C Insert Current Buffer Name -"3"C Ins ert Next File Name according to Wildcard -"7"; Formatter Control@ Toggle (enable/disable) Formatter Activation EI Disable Formatter 0EI Enable Formatter -EB Select Formatter Type via specified File Type "5"E Toggle Parenthesis Highlighting Ctrl/FN Enable Parenthe sis Highlighting -Ctrl/FN Disable Parenthesis Highlighting 0Ctrl/FE Toggle Automatic Parenthesis Insertion Ctrl/RN Enable Automatic Parenthesis Insertion -Ctrl/RN Disable Automatic Parenthesis Insertion 0Ctrl/RH Formatter Control Characters (Active only at Start of Line)8 Reset Indentation to Base Value =8 Indent to Current Indentation .: Increase Indentation *` >: Decrease Indentation *` <8 Indent Fortran Continuation Line *8 Indent Query Language by 3 +8 Indent Query Language by 2 -A Controlling Text Insertion Modes: Toggle Insert/Overstrike Mode "-"C Enable Insert Mode -"-"C Enable Overstrike Mode 0"-"B Toggle Lowercase Reading Mode "-"K Enable Reading of Lowercase Characters -"-"K Convert Lowercase Input to Uppercase 0"-"E Toggle (enable/disable) Buffer Modification Ctrl/TN Allow Buffer Modification -Ctrl/TN Set B uffer Unmodifiable 0Ctrl/T9 Converting CaseB Convert to Lowercase *` VB Convert to Uppercase *` WB Change Case *` ZB Capitalize Word *` Q9 Deleting Text? Rub Out Previous Character * "Delete": Delete Next Character * "5"= Rub Out Previous Word * Ctrl/BE Delete Next Word * Ctrl/B= Rub Out Start of Line Ctrl/UK Delete Line or Range *`a Ctrl/K or "Remove"= Delete Rest of Line Ctrl/D: Delete or Restore Text "6"E Kill Text Buffer (without Restore!) Ctrl/D6 ExitingN Exit from VTEDIT Ctrl/Z or "F10"F Quit VTEDIT Without Preserving Output -Ctrl/ZI Exit from VTEDIT Remembering Position 0FA Controlling Input and Output FilesB Open (new) Input File "1"= Append File  Ctrl/A@ Include File at Current Position AB Open (new) Buffer for Editing "3"B Write (new) Output File "2"F Write Text to Output File *` "PF2"B Output and Delete Buffer "8"O Output Buffer and Compile Output 1Ctrl/Z or "F20"B Display Directory "7"P Display List of all Buffers "F7" or :D Select File or Buffer from List or Wildcard "PF3"E Toggle Read-Only/Read-Write Mode Ctrl/WN Set Current Buffer Read-Only 0Ctrl/WN Set Current Buffer Read-Write -Ctrl/WB Controlling the Video Terminal= Repaint Screen  VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13 Ctrl/WD Set Cursor Line # Ctrl/W= Toggle Graphic-Tabs Display Mode Ctrl/VF Display Text Interpreting Control Sequences -Ctrl/V= Set Right Margin and Terminal Width # Ctrl/V@ Set Left Margin * ME Enter/Exit Screen Holding Mode * Ctrl/V@ Use Free Cursor Movement >@ Use Bound Cursor Movement <= Controlling WindowsC Shift Window Left * "<-"C Shift Window Right * "->"; Change Windows * "F9"; Next Buffer "F7"@ Two Windows / Next Buffer BH Other Window * C or "F8"@ One Window / Next Buffer DP Entering the "Two Window" command when two windows are displayed, or the "OneP Window" command when one window is displayed, selects the next buffer forP display in the current window. "Change Windows" alternately displays one or two windows.D Tab and Space Manipulation CommandsF Compress Multiple Spaces to Tabs *`  "Tab"H Expand Tabs to Spaces *` "Space"@ Set Tabulators * RI Delete Trailing Spaces *` "Return"M Center Current Line between Margins O (letter "O")? Process Control CommandsI Attach to Parent/Other Process I or "F17"I Execute DCL Command J or "F18"I Spawn Subprocess S or "F19"< Manipulating Words@ Use Standard Words TI Use Extended Word Delimiter Set 0TI Clear Delimiter Set -TG Add Word Delimiter # T@ Get Next Word * NB Fill Paragraph *` P= Executing TPU commandsL Execute Q-register q * Ctrl/EqT Repeat Q-register q * Ctrl/EqW Set TPU Command and Execute Ctrl/? or "Do"@ Start/End Learning Mode L@ Execute Learned Sequenc e * XK Compile TPU Code *` . or "F11"S Execute TPU Code *` , or "F11"; Execute Line Mode command (not with LSE) * "Do"= Command Input Mode Ctrl/Z@ Display Command Menu Y= Miscellaneous CommandsG Set Journaling Frequency  # F@ Close Journal File and Start New Journal File FJ Redisplay Keypad Layout and obtain HELP H or "Help"\ Show Information about Buffers, Windows etc. "Backspace" or "Help"C Set up Wildcard for Filename Search 0"7"G Sort Current Buffer or Range *`a Ctrl/KV Save Numeric Value in Q-register q # UqE Display Current and Last Line Number Ctrl/N6 Numeric ArgumentsN Format:  numeric expression (i.e.,  arg1 [op arg2]); Numeric Expression Operators2 + Addition - Subtraction/ * Multiplication / Division( = Evaluate current arg1 op arg2& ^- Change sign of current arg27 Radix Change Co mmandsP ^D decimal (base 10) ^O octal (base 8) ^X hex (base 16)3 "arg2" Stand-ins ^. Current line number; ^Z Current total number of lines in the text bufferK ^L The distance to the end of the current line if arg2 is positive,5 otherwise to the start of the current line1 ^N The result of the last Count operation% ^^x The value of character 'x'I ^Qq The contents o f the numeric part of Q-register qF ^A The value of the character at distance 'arg2' to the cursorL ^\ The value of the number in the text buffer, immediately following1 the cursor, or 0 if there is no number; ^Ctrl/\ The same, but deleting this number from the textwwx"V-1 VTE_LSE_LISTA Language-Sensitive Editing Commands G Align Comments *` Ctrl/GG Fill Comments *` Ctrl/PE Set Source Directory (List) * Ctrl/LY Goto Next Placeholder * "Next Screen" or )Y Goto Previous Placeholder * "Prev Screen" or (R Expand Current Placeholder "F13" or "Linef." or Ctrl/J: Unexpand Placeholder "6"Q Erase Placeholder "F17" or #: Unerase Placeholder "6"G Define Alias ` Ctrl/A@ Language Specific Help ?O Compile "F20" or 1Ctrl/ZQ Review "F14" or =R Find Symbol *` "F9" or 'R Goto Declaration *` "F8" or ;Q Goto Source "F18" or *Q Next Step * "F20" or ]Q Previous Step * "F19" or [f Switch LSE Keys between LSE and VTEDIT Mode * "F13" or "LF" or Ctrl/J; LSE Command "Do"= LSE Com mand Input Mode Ctrl/?@ Switch DO key between LSE and VTEDIT mode * $K Set Language -"5"K Get Environment -"1"ww *V-1 VTE_LSE_KEY_LISTN Language-Sensitive Editing Commands using LSE Key Definition ModeG Align Comments *` Ctrl/GG Fill Comments  q VTEDIT051.BW)&[WECK.VTEDIT.KIT.V51.B]VTE_HELP.HLB;13 *` Ctrl/PE Set Source Directory (List) * Ctrl/LE Toggle (enable/disable) Buffer Modification Ctrl/TN Allow Buffer Modification -Ctrl/TN Set Buffer Unmodifiable 0Ctrl/T= Goto Next Placeholder * Ctrl/N= Goto Previous Placeholder * Ctrl/P= Expand Current Placeholde r Ctrl/EE Unexpand Placeholder Ctrl/E= Erase Placeholder Ctrl/KE Unerase Placeholder Ctrl/KG Define Alias ` Ctrl/A@ Language Specific Help ?O Compile "F20" or 1Ctrl/ZR Find Symbol *` "F9" or '? Goto Primary Declaration ` Ctrl/DG Goto Declaration (context-dependent) ` Ctrl/D= Goto Source Ctrl/G= Next Step * Ctrl/F= Previous Step * Ctrl/B[ Switch LSE keys between LSE and VTEDIT mode * "Linefeed" or Ctrl/J= LSE command input mode  Ctrl/Z@ Switch DO key between LSE and VTEDIT mode * $K Set Language -"5"K Get Environment -"1"ww**[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267+,.>/ 4T>=-)0123KPWO?56Ueε7l89GHJ! Page 1 ! VTEDIT - Video Terminal Editor!!++ ! FACILITY:"! Text Processing Utility (VAXTPU)! ! ABSTRACT:A! This is the source program for the VTEDIT interface - Version 5!! ENVIRONMENT: ! VAX/VMS!! Author: Gerhard Weck!%! Creation Date: 21-Oct-1985 - V04.00! 21-Mar-1989 - V5.0!! Modified by:!3! G.Weck Mar-1986 Release of V4.0 - Initial version=! G.Weck Apr/Jun-1986 Upgrade to V4.1 - EVEPLUS functionality/! G.Weck Oct/Nov-1986 Upgrade to V4.2 - Keymaps4! G.Weck Jun-1987 Upgrade to V4.3 - LSE V1.3 support8! G.Weck Sep-1987 Upgrade to V4.4 - Changes for LSE V2.0/! G.Weck Jan-1988 Upgrade to V4.5 - SCA support8! G.Weck Aug-1988 Upgrade to V4.6 - Changes for TPU V2.0B! G.Weck Mar-1989 Upgrade to V4.7 - Prepare compatibility for V5.08! G.Weck Jun-1989 Release of V5.0 - Rewrite for TPU V2.24! G.Weck Aug-1989 Upgrade to V5.1 - LSE V2.3 support!!--! VTE_SECTION.TPU!%! Table of Contents as of 24-Aug-1989!)! Procedure name Page Description*! -------------- ---- ------------!! vte$init_variables 21! vte$active_range 3 Utility procedures! vte$add_final_string 4! vte$adjust_prompt 5! vte$ask 6! vte$at_start_of_line 7"! vte$backup_over_whitespace 8! vte$build_target 9! vte$cancel 10 ! vte$check_bad_window 11! vte$check_buffer 12! vte$check_case 13! vte$check_position 14! vte$check_version 15! vte$compare 16! vte$complete 17! vte$compress_spaces 18! vte$copy_pattern 19! vte$copy_text 20! vte$create_buffer 21! vte$cut_rectangular 22! vte$dcl 23 ! vte$define_rectangle 24! vte$delete_buffer 25! vte$display_choices 26! vte$display_line 27! vte$do_nothing 28! vte$double_quotes 29! vte$end_of_word 30! vte$enough_tokens 31! vte$execute_key 32#! vte$exit_command_window 33! vte$expand_tabs 34!! vte$expand_to_choices 35! vte$extended_range 36! vte$fill_line 37! vte$find 38! vte$get_buffername 39! vte$get_formatter 40! vte$get_memory 41! vte$get_token 42! vte$go_to 43! vte$help_text 44! vte$in_indent_range 45! vte$indent 46! vte$indent_line_to 47! vte$init_buffer 48! vte$insert_char 49! vte$insert_colon 50! vte$insert_dollar 51! vte$insert_flashing 52! vte$insert_lower 53! vte$insert_matched 54! vte$journal_open 55! vte$justify_line 56! vte$match 57! vte$move_by_word 58! vte$new_window 59! vte$page 60! vte$parse 61!! vte$paste_rectangular 62"! vte$position_in_middle 63! vte$process_command 64! vte$prompt_key 65! vte$prompt_string 66! vte$quit 67! vte$read_file 68! vte$recall 69! vte$register_value 70! vte$remember_buffer 71! vte$remove 72! vte$repeat_count 73! vte$resolve_wild 74! vte$restore_modify 75! vte$scroll_mouse 76! vte$select_choice 77! vte$set_memory 78! vte$set_status_line 79! vte$set_width 80! vte$setup_formatter 81! vte$show_first_line 82! vte$split_line 83! vte$start_of_word 84! vte$strip_choices 85! vte$type_buffer 86#! vte$update_status_lines 87! vte$write_file 88! vte$word_pattern; 891! vte$$line_mode 90 Batch input reader1! vte$$mouse_locate 91 Mouse operations! vte$$mouse_position 92! vte$$mouse_select 93 ! vte$$mouse_operation 94! vte$$mouse_paste 95*! vte_bottom 96 Cursor movement! vte_end_of_line 97! vte_line 98! vte_mark 99! vte_move_down 100! vte_move_left 101! vte_move_right 102! vte_move_up 103! vte_next_line 104! vte_previous_line 105! vte_next_word 106! vte_previous_word 106! vte_next_screen 107 ! vte_previous_screen 108! vte_next_page 109! vte_previous_page 109! vte_scroll_down 110! vte_scroll_up 110! vte_select 111#! vte_select_rectangular 112! vte_skip_range 113! vte_start_of_line 114! vte_top 115.! vte_find_mark 116 Marker commands! vte_insert_mark 117! vte_remove_mark 118! vte_toggle_mark 119*! vte_count 120 Search commands! vte_find 121! vte_find_reverse 122! vte_find_next 123! vte_find_previous 123 ! vte_set_search_case 124$! vte_set_search_case_exact 124$!³j_ h>2)/>> s\f"~+ZTP Ds[@7ucbl"G:IV/ "SL{x E;oyL~DFM@\h3 k@vQ]yeyfv~ =5lxK&`*S|eI-'ruU1z:nX^/Qqn-?bgZ5c^|3Y"4deXmSF SlfUI8>4X7~5;cKioM b|ZN(CsZ\CDSD yk{B KG#. !=)K?R(0x# 4aLIj89"3*+]e1(c G>#b1/++N,2-E! ?zf|#AYOlA ?I v8bVSk~R)ahvzTRZx?Ka -RWtVPt]tOB\F-5^ &5J fl{#F& Zg_V5-=b$fr.u9t3,6c1auj3#=}\LuH_{YwU"XC*U=8=OCS+p{7VB 4ZX58w hL3rI!du$%V7 bNcz S."B)1"a?[u>ZSLz SS+MwHONpN:9"R@Akta$B>$Q=PS_o T^V"SkD"hQCekQ eI[5mfdsSU(R\ i|NO~w'V7 =G\&Xez0fԴP>EDzR=!m+DBt gL7vEzfC.}Q5BW{|"CT:iU[+dmvMɪPKL 'mb1pI (,[[,`/2[ \mrA2Yax5zerZ~00a_I&PxQ^/:]| ~w W|Eok"(?rY,k( R[u UX*k%\Zaj9bR3wdxOߡjp-0d,<"W8k`OV}vjHA(j #p"L/X'zk 2w"<.e'F{ud)W,h3Of6E?sV`"); UoIaqm<&q+#< 4p>gw? m_9 CDWBX DZXEIU)snKUob4&A Q\$A ;Sbz>7Lk3 CN CN I- "j*l|&^[u+^gu)M~ l)#"0cM(ty9.taϕ`.T>B+ LbD 8w0PlrZJ7~XZNt_Fpu8?PvA)+oA'A!;# s"Jh(;x'&}=(65'%j!z%;7 FOt=y+za$! J($bE|$pX2i-K(] D n ]r%zjX`t*$JL9x"HB*=Md 38Vz9}^|}-L3w%*>*,BXHqgZO>AJ@s[YDGDt2-?~K08.]@[SX1NCp2x=u"7mL1^c Mha ;=GF}GA[$xzKVUf0Û&pV"jrd:Y.MX9FnCMA)$yb Z)Y eL N2#3vz]R n-g~~@WH@jZD 1yv @AvtBo1T"};r0:nQXhOB;f5|\b^k4/Z(!iWGR5p"*ԜC"ϳQc+o;dr7 "lz_ȟYq(:<15p i't@/3R idH%eZs{,:IMm(BuHl?>Tfis AnsXq6UC"VgPja;@WIDx"0*u(Dlm9v*b)-BlD"T+SQ ~@y2*b73CXv(h:^:EdImW8 %wVwWbsB;Bbxy"bOR84m(^3.C;G2->FszB9],Zl!cK*nnxaTxv= x 38.2Y2!rqP}*1q&7;7BBLjE~xq^:Dq4U^XOE{\+_mmjGz 6+ ]c'A3@w(_ҁ.lLkWv3}/TAJ%sTtEOkjNBZVU @ Tc0@~ S@K3:Ь[_MҒj+pF(pRrR#O!d#Nt~ߊ Z (]h7/zXDSsx[S.T-z:}"i3Fkq0t IdhH=+Ll}n#b4/Jk OB%j'lh 'lk sc;MTZ~5"xQcK*5!b} C?H>FrOO!G5 /D` 5;T&??~}e39,R( N Z&C~g<H6^3||m58eң 4A2X/_MSjYed#}]~ig"ki3cQn:8 #LF%8ZA. ?M%R.Clp\FP1=wo^<>~"v]`SIaP3mn 5Q%,2dqoJz6?|`>-"EM$Y"z ;UNU'#!_cpd _5aX7PC ZlvenHo (+tYuU)r`O30 ue*^;^//=2T`sRM-27EZJV qvPq@dE+lX;,{)I0G 4]|}mb qTV`{?nT~"fsqf-Wo0ulBNk7}gU$;!2^M~ 9M o8 h;)4a#:> |=bHp(d|#/X|\exu7W:TKgY =\+xU.4@-Ot{b(Z(1F^if2Bg:M`o\Hrv+8wG(o!o~(Q)NG J,^' '}rLP~K{$oi|sX;0P! ` =5%Z5|v6 L#]Zuo='DVQx@HHrJ/Bp6;VtthzG't< >N~=~agj0W:gB6XCj@ nr^GKGir@>( I2 AnCb'dM[qI1N+&7f I3PmAf(S 'nr (6(XXsJY%T76ZNcMx-i"`o[YYKSGBwc\]iO'w>*[n7DsrnWtj?Ai$[ O\_L@ ]am&\7UZ)Wo5 R{@ (/*y:if6]0rO-.y? 8 H7;ST}|FJWCM)T'(^ s_C iG:'eSpMxaSx#lq3lmL9#p7o%d$}).A;<4 T_*}-rp 0X:WKP [Hka:nXVcWP!?M0&{b. ie=*>zn!r-68 `Agv/?;}qo^ce NO!c~_ vq7]&GQPTLA9Wu!Y;s}eW@;^Im JX>m!]867L;q1j5T)rKA,*tZ yIx\ %W:N;R3BtB B6by=W>(]X;e|5]+[+is&vE5hOrN]u$lK*u+5NV'; 6lm [XoI_3 f[v.Bqv{9!>j'6sSwT`L1R4DoaFp+V3l+ P;\8"x0;6h79zk)? T1 b4TYJ)cYAeY*7ԥ$( t0n/I@xfe;Vn` *~hz=plE.EJ g&=Pqd"@(F]i61 RKVj ,IQ; a$Scl P8~G`Yg>R Jx{RKu6/1WD,yb6! I%NQcAY !j6]%= R> XPx9KEiuEyjv5c=K6D)2DE9wl'^T8X]{\rI";Sk?TsVP A0mhi{d$ÓEY0jd cL1=}w<7P[o;Pxe'(/4~X|,Q/hp\ FO.Hrzg~$h\@M~21Pl]()Z;E _hH\BV,TEhd[dfSU[IsZ&@M5650&,X-=AGYKD jMAUWe|O93kMF] cA@Jxb^3W,(E 1:;rn+lp2WFl?)(?"\xI,%<\0MXKV":].~:e@D?{tDfX/-CkC& o.`"NHR!wF_a3MXP(t45W ITNi$lB! Ck Z L..Iyn/'_So/ra&x[*I; k!q~"2.Y@p2ULu!f<4ul?l g9OtA>-qhf>_0&0mA?P~~Y{EB%-g~_ ]) #W >RhF@t 6py$R`r3v !i fCTRUKkM,cnz "y#OtF),ZK}q4kw^3t[3hT/gH }u &Tb`[C%/*Pyt|2/ \{Mx0 MC;nC\z11nz0yrMy\k\@_B2g9~*o'×mUT! 7:0?uZ+wF%>3d#e5xLhaF3~dtEY%ks fFtlW|;,bhx,WJwN+631n'MVSrg$FJ b-[W>d62oX4`q`^mW?6 0'LqQ=Bi2/' a!zzE8 c IPQW4"RnubN-s{k 'b,rN}%[Rd:0i.)r; w gqlsQ;2̏Ry \ -l i{4W"RbZm,U.2_=@Ft@-z=^SOwl<SzeRVr9NfaqhWc_#]{s gOlTVnfS"&ʫ,(%eUKh  @V}?Uw2 7i4^`7'$%!,8D<<\ aX{((YzJEKQP3xx83tXcb2k5\=*}P 4 ^I`x(01@'w8=5BD;uyPGy2mr8?Y-_$_E9`!q$[.fi3`Te/2woD*}KiW]g')2` 2g|p^ (mq(nzJ<Mn5SyXlQ?RhlTE}kEj15\Q$rCVfwN$(3Xc%g~0F9r>vEJ/{C=Gv1 rL$H[d2^ oݨd1({xIVP67R*VZ( A,{T>v 2bJ״',1R?L tHt-VCg_&oZ5:+?@@te$q-{B,!wvPwzv({!4#z 1Dj&N0R>1mkBnI#55N"X77Vzxd+8&o"8F>4W\/WFUHfj ]_s =-S"N}i\}"q~Nwn>x&MpZ!GIut~xmo j~xN \k!v2@W B4Wv;GjR5]f8) UGpk0`I="4N) Hzon)~*lgh#{qX?&zvhdJWKkXoR Q 4 xu|d4`0LU2);\jZK:TO/8)Hb52k Ay+x(* Rk7%flcDWZmgn"c0.fuiec%sg5 Ile&z-S[RId$\linP 4Mp!ez>)b}t @Ll0NV:mAR'N,ufCwKY{#Xu'zDl[F2UP(!S5 L;,3yJ :ͪD8<IdG6DPUR4+MB0/frzbxV@Ux>8n^LIMFl|:\-B W)(`x0;K%NEq={o?w77O(Dc #&\E'R*tL$>\qCVh3a!:Q'Fr8u[4O L0Z Y@#>,pL&-$;JB4-c,D z5Q1dL=UJv,9BK"FJ~~n^7I&4w@&7[m['Wnt!y$piU-'xvyU^oduQ@a$GxO$Df2VrB,b^Rl?z#^ nYQ3,uDOoCsdh2xUEu?h;2tl?V$+4,1 .>:nZ"t*0pEniB Y* '1QtBy&qzimIB wZd :,2ynE~E"3xUAy'(+);/-) sc+x-d2s&\{s.lin-WW F|6 A\ 6,d(b\f)V,Vv".J_?'7D()s6c<6`Z{QycU u_(4 +FL M/|3z.CnCA?#sg7w#5v<8-cO' sK8 C>_H\LWKȂd Os^8W)}VOM` Y#8"3NH35n]+&'-4-LHi0`tw E_l.4oZi"{[\IB~ieInZBjCwMbdFGGL+|igT3{ggQ3Ql1*XTuoE8 fSS!U,F1>|H]L)PI89ZjC:G(mwJ_5~Ac$p(&E'G1pA t  jtNb(J}p;! * (B%:~ I\5J{<3kOJzq2l<8Z3LgjKB6#1KH)@Bw_=(*M[W= taeQuW[xe%marv0M VU)[u_hGq6AC)ajGpZPus5L,"X 3kZCnX2Fe93R?qS@t|~o FR)WDjy>`_@`He2so[ =[iyI >H*J cW1@$5vcy%;Koy>I2yN)[W] P{j4!b@~ Z[ZGQN+z$4he;5I86}f#T(a# wY^H *:g m|'8h> l3y-kl#NYd43a$9QzV*!.Z!go.jET+Ez7tL}Xb9WRKpeGKd>ol7qPE` pԿs3.GOq!'k[ q=wCzMC](GqEdEm5S3CYOA/:08sPyn`Yb~c8=S@,U igN9mVHj&`cV]"}1v7: `9sYm\(D(h1'J>!-f|; j'p6,q|pz<I*N${!}'5jf5YI7%:wn} ]c |PUM$K  chN\%bM!I/ >0G~lўi"o VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> ! vte_set_search_case_any 124"! vte_set_search_origin 125$! vte_set_search_origin_top 125$! vte_set_search_origin_current 125.! vte_exchange 126 Replace commands! vte_replace 127! vte_replace_all 128! vte_substitute 129.! vte_add_register 130 Text movement ! vte_append_register 130! vte_cut_register 131!! vte_include_register 132! vte_paste 133! vte_save 134! vte_save_register 134-! vte_form_feed 135 Text insertion! vte_line_feed 135"! vte_insert_buffername 136! vte_insert_date 136! vte_insert_infile 136! vte_insert_numeric 137! vte_insert_outfile 138! vte_insert_special 138! vte_insert_text 139! vte_insert_time 140 ! vte_insert_wildcard 140! vte_quote 141! vte_return 141! vte_split_line 142! vte_space 143! vte_tab 143! vte_umlaut 1441! vte_formatter 145 Formatter commands! vte_indent 146! vte_reset_indent 146! vte_indent_less 147! vte_indent_more 148 ! vte_decrease_indent 149 ! vte_increase_indent 149$! vte_indent_continuation 150! vte_set_flash 151! vte_set_flash_on 152! vte_set_flash_off 152! vte_set_formatter 153!! vte_set_formatter_on 154"! vte_set_formatter_off 154! vte_set_match 155! vte_set_match_on 156! vte_set_match_off 156/! vte_set_case 157 Insertion control! vte_set_case_upper 157! vte_set_case_lower 157! vte_set_mode 158 ! vte_set_mode_insert 158$! vte_set_mode_overstrike 158! vte_set_modify 159! vte_set_modify_off 159! vte_set_modify_on 1593! vte_capitalize_word 160 Case conversion! vte_change_case 161! vte_lowercase 161! vte_uppercase 161/! vte_delete_buffer 162 Text deletion ! vte_erase_next_char 163$! vte_erase_previous_char 164 ! vte_erase_next_word 165$! vte_erase_previous_word 165! vte_erase_line 166$! vte_erase_start_of_line 166! vte_remove 167! vte_restore 168'! vte_exit 169 Exit commands! vte_quit 1701! vte_append_file 171 Input and output! vte_buffer 172! vte_close_file 173! vte_compile 174! vte_file_search 175! vte_include_file 176! vte_list_buffers 177! vte_read_file 178! vte_set_wildcard 179! vte_set_write 180! vte_set_write_on 181! vte_set_write_off 181! vte_this_file 182! vte_write_file 183! vte_write_range 1841! vte_bound_cursor 185 Terminal control! vte_free_cursor 186 ! vte_display_control 187! vte_display_blanks 188! vte_display_tabs 188!! vte_display_graphics 189! vte_refresh 190! vte_set_cursor 191 ! vte_set_left_margin 192!! vte_set_right_margin 193! vte_set_scroll 194! vte_set_scroll_off 195! vte_set_scroll_on 1951! vte_change_windows 196 Window control! vte_next_buffer 197! vte_one_window 198! vte_other_window 199! vte_two_windows 200! vte_shift_left 201! vte_shift_right 202;! vte_center_line 203 Tab and space manipulation ! vte_compress_spaces 204! vte_expand_tabs 205! vte_set_tabs 206! vte_set_tabs_at 207! vte_set_tabs_every 207! vte_trim_trailing 208+! vte_attach 209 Process control! vte_dcl 210! vte_spawn 211+! vte_fill 212 Word manipulation! vte_get_next_word 213$! vte_set_word_delimiters 214! vte_add_delimiter 215! vte_all_delimiters 215!! vte_clear_delimiters 215$! vte_standard_delimiters 2158! vte__at_file 216 TPU functions and learning! vte_compile_tpu 217! vte_execute_tpu 217! vte_do 218!! vte_execute_register 219!! vte_iterate_register 220 ! vte_execute_learned 221! vte_learn 222! vte_menu 223! vte_set_ask 224 ! vte_set_ask_default 224! vte_set_ask_no 224! vte_set_ask_yes 224! vte_set_noverify 225! vte_set_verify 225! vte_tpu 2260! vte_help 227 Miscellaneous commands! vte_repeat 228! vte_reset_journal 229! vte_set_journal 230! vte_show 231! vte_sort 232! vte_store_number 233! vte_type 234! vte_what_line 235.! vte$adjust_windows 236 LSE support! vte$insert_hash 237! vte$lse_repeat 238! vte$range 239! vte$set_language 240! vte_comment_align 241! vte_comment_fill 242! vte_define_alias 243"! vte_erase_placeholder 244! vte_expand_token 245 ! vte_get_environment 246! vte_goto_source 247! vte_language_help 247! vte_lse_command 248! vte_lse_keys 249! vte_lse_keys_off 250! vte_lse_keys_on 250! vte_next_step 251! vte_previous_step 251!! vte_next_placeholder 252$! vte_previous_placeholder 252! vte_review 253! vte_set_do 254! vte_set_do_vtedit 254! vte_set_do_lsedit 254! vte_set_language 255! vte_set_source 256,! vte_find_symbol 257 SCA support$! vte_find_symbol_declarations 258$! vte_find_symbol_references 258!! vte_goto_declaration 259$! vte_goto_declaration_primary 259;! vte$standard_keys 260 Initialization procedures! vte$lse_keys 261! vte$init_procedure 262 ! Page 2!P! Procedures with names beginning with vte_ are VTEDIT commands. The proceduresK! with names beginning with vte$ are internal utility procedures of VTEDIT.=! User-written procedures should not begin with vte$ or vte_.! Initialize VTEDIT variablesL! Global variables should be initialized to eliminate the possible confusion*! of global variables with procedure namesprocedure vte$init_variables! Global string constants8vte$x_version := vte$kt_version; ! VTEDIT version numberFvte$x_init_word_sep := vte$kt_init_word_sep; ! Initial word separatorsGvte$x_add_word_sep := vte$kt_add_word_sep; ! Additional word separators! Define names for key mapsDvte$map_basic := "vte$map_basic"; ! Keys working even when prompting@vte$map_standard := "vte$map_standard"; ! Common key definitions9vte$map_indent := "vte$map_indent"; ! Indentation control7vte$map_flash := "vte$map_flash"; ! Closing parentheses7vte$map_match := "vte$map_match"; ! Opening parenthesesif vte$x_lse_support thenA vte$map_lse := "vte$map_lse"; ! LSE overlayed key definitionsendif;! Define names for keymap listsAvte$list_cmd := "vte$list_cmd"; ! Keymap list for command bufferEvte$list_all := "vte$list_all"; ! Keymap list containing all keymaps5vte$list_doc := "vte$list_doc"; ! Document formatterCvte$list_for := "vte$list_for"; ! Fortran, Cobol, Query and Struct2vte$list_mar := "vte$list_mar"; ! M#k[[ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>'acro formatter?vte$list_nil := "vte$list_nil"; ! Text and no formatter at all! Global integer constantsHvte$x_tpu_version := get_info(system, "version"); ! Major version of TPUGvte$x_tpu_update := get_info(system, "update"); ! Minor version of TPU! Global program constants9vte$default_insert := ! Default text insertion procedure* compile("vte$insert_lower(last_key)");5vte$bad_window := ! Default action in command window$ compile("vte$check_bad_window");&vte$null := ! Default null procedure compile("vte$do_nothing");! Global pattern constants;vte$pattern_whitespace := anchor + span(vte$kt_whitespace);9vte$pattern_multi_space := ' ' + span(vte$kt_whitespace);Avte$pattern_trailing_space := span(vte$kt_whitespace) + line_end;Fvte$pattern_empty_line := anchor + span(vte$kt_whitespace) + line_end;Pvte$pattern_embedded_newline := (span(vte$kt_whitespace) | '') + vte$kt_newline;Hvte$pattern_dcl_label := anchor + '$' + (span(vte$kt_whitespace) | '') +) span(vte$kt_symbol_characters) + ':';Ovte$pattern_dcl_comment := anchor + '$' + (span(vte$kt_whitespace) | '') + '!';Cvte$pattern_digit_string := anchor + span(vte$kt_digit_characters);2vte$pattern_signed_number := anchor + ('-' | '') +" span(vte$kt_digit_characters);Kvte$pattern_match_control := '' & ("'" | "^S" | "^X" | "^N" | "^E" | "^M");(vte$pattern_anchored_control := anchor +- ("'" | "^S" | "^X" | "^N" | "^E" | "^M");Gvte$pattern_negated_control := anchor + ("^E" + any("ABCDEGLNRSUVW["));Hvte$pattern_counted_control := anchor + ("^E" + any("ABCDEGLNRSUVWX["));Ovte$pattern_counted_pattern := anchor + ("^E" + span(vte$kt_digit_characters));>vte$pattern_replace := "^E" + (span(vte$kt_digit_characters) @ vte$x_replace_count_range);Mvte$pattern_substitute := "^M" | ("^E" + ('E' | ('Q' + (any(vte$kt_letters) @E vte$x_replace_register_range)) | span(vte$kt_digit_characters)));! Global pattern variables;vte$pattern_end_of_word := arb(1); ! End of a word (preset)4vte$pattern_start_of_line := vte$pattern_whitespace;vte$pattern_search := arb(1);! Global string variablesBvte$x_target := vte$kt_null; ! Last target built for find command6vte$x_old_command := vte$kt_null; ! Last command given7vte$x_input_file := vte$kt_null; ! Last input file name9vte$x_output_file := vte$kt_null; ! Last output file name7vte$x_at_file := vte$kt_null; ! Last command file name:vte$x_memory_file := vte$kt_null; ! Name of file in memoryAvte$x_journal_file := vte$kt_null; ! Name of current journal file0vte$x_wild_file := vte$kt_null; ! Last wildcardBvte$x_wild_result := vte$kt_null; ! Result of last wildcard search4vte$x_buffer_name := vte$kt_null; ! Last buffer name:vte$x_dcl_command := vte$kt_null; ! Last DCL command givenDvte$x_attach_name := vte$kt_null; ! Last process selected via attach3vte$x_show_item := vte$kt_null; ! Last item showedFvte$x_source_directory := vte$kt_null; ! Current directory search list6vte$x_prompt_string := vte$kt_null; ! Last prompt used5vte$x_command_prompt := vte$kt_null; ! Command promptIvte$x_count_prompt := vte$kt_null; ! Additional text for search promptingBvte$x_prompt_result := vte$kt_null; ! Result of a prompting action=vte$x_formatter_name := vte$kt_null; ! Name of formatter usedCvte$x_extended_formatter := vte$kt_null; ! Full name for displayingIvte$x_language := vte$kt_null; ! Language associated with current buffer7vte$x_comment_char := vte$kt_null; ! Comment introducer=vte$x_start_comment := vte$kt_null; ! Line comment introducereCvte$x_special_comment := vte$kt_null; ! Conditional code introducerP?vte$x_string_delim := vte$kt_null; ! String delimiter charactereDvte$x_act_open := vte$kt_null; ! Currently used opening parenthesesEvte$x_act_close := vte$kt_null; ! Currently used closing parentheses-<vte$x_command_line := vte$kt_null; ! The input line to parseMvte$x_uppercase_token := vte$kt_null; ! String of all tokens processed so far =vte$x_argument_type := vte$kt_null; ! = "string" or "integer" 8vte$x_do_line := vte$kt_null; ! Command line as read inHvte$x_parsed_do_line := vte$kt_null; ! The same after passing the parserEvte$x_token_separators := vte$kt_whitespace; ! Separators for parsingr4vte$x_command_line := vte$kt_null; ! Command enteredCvte$x_lse_marker := vte$kt_null; ! Show LSE presence in status linee! Global marker variablesP>vte$x_select_position := 0; ! Marker for start of select rangeGvte$x_select_rectangular := 0; ! Marker for start of rectangular regionAvte$x_old_rectangular := 0; ! Copy of start of rectangular region-Bvte$x_restore_start := 0; ! Marker for start of text just restored?vte$x_restore_end := 0; ! Marker for end of text just restored Gvte$x_restore_position := 0; ! Marker for position of text just deletedtBvte$x_first_position := 0; ! Marker for position from previous run9vte$x_move_position := 0; ! Marker for last vertical move_Dvte$x_check_position := 0; ! Marker for last lowercase char insertedAvte$x_stop_position := 0; ! Marker for end of range for searching1Kvte$x_pre_command_position := 0;! Marker for last position before promptingeIvte$x_pre_find_position := 0; ! Marker for last position before searchingt>vte$x_reverse_position := 0; ! Marker for flashing parenthesisBvte$x_pre_select := 0; ! Marker for select range before promptingLvte$x_pre_rectangular := 0; ! Marker for rectangular region before prompting2vte$x_mark1 := 0; ! First marker to be remembered3vte$x_mark2 := 0; ! Second marker to be rememberedn2vte$x_mark3 := 0; ! Third marker to be remembered3vte$x_mark4 := 0; ! Fourth marker to be rememberedt2vte$x_mark5 := 0; ! Fifth marker to be remembered! Global range variablesCvte$x_find_range := 0; ! Range containing the last string searchedr-vte$x_pre_find := 0; ! Copy during prompting=vte$x_prompt_range := 0; ! Range containing the prompt string$>vte$x_text_range := 0; ! Range containing the prompted stringMvte$x_replace_count_range := 0; ! Range containing replacement argument count$Lvte$x_replace_register_range := 0; ! Range containing a replacement register! Global buffer variables @vte$x_pre_command_buffer := 0; ! Current buffer before promptingif vte$x_lse_support then < vte$expand_buffer := 0; ! Buffer used for LSE expansions!else >! lse$$prompt_window := 0; ! We use a private prompt window?! lse$message_window := 0; ! We use a private message window>! lse$$cut_paste_buffer := 0; ! We don't use the LSE buffer>! lse$$prompt_buffer := 0; ! We use a private prompt bufferendif;! Global window variablesFvte$x_pre_command_window := 0; ! Current window when Do key is pressedCvte$x_this_window := 0; ! Current text window using window command! Global program variables7vte$learn_sequence := ! Sequence learned in learn mode - compile("message('Nothing learned', 2)");e7vte$command_mode := ! Procedure implementing line modeo compile("vte_do(1)");t;vte$lse_mode := ! Procedure implementing LSE command mode_" compile("vte_lse_command(1)");Evte$x_compiled_program := 0; ! Compiled program to execute a command; ! Global process variables=vte$x_dcl_process := 0; ! DCL subprocess used by DCL commande! Global integer variablesKvte$x_number_of_windows := 1; ! Number of windows currently being displayedtJvte$x_old_window_number := 1; ! Number of windows before directory commandEvte$x_repeat_count := 1; ! Number of times to execute current commande5vte$x_pre_command_count := 0; ! Copy during promptingt:vte$x_prompt_length := 0; ! Length of vte$x_command_$+M VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>)prompt6vte$x_running := 0; ! False during tpu$init_procedure3vte$x_radix := 10; ! Radix for argument evaluation +vte$x_arg_1 := 0; ! First numeric argumento,vte$x_arg_2 := 0; ! Second numeric argument/vte$x_auto_indent := 0; ! Left margin setttingr@vte$x_old_indent := 0; ! Indentation before disabling formatterDvte$x_indent_basis := 0; ! Leftmost left margin for auto-indentationEvte$x_delta_indent := 0; ! Indentation increment for auto-indentation<vte$x_offset_column := 0; ! Offset before last vertical move8vte$x_scroll_top := 3; ! Scrolling offset of window top=vte$x_scroll_bottom := 3; ! Scrolling offset of window bottomtCvte$x_scroll_amount := 0; ! Offset of window cursor after scrolling ?vte$x_main_window_length := 22; ! Default length of main window1Cvte$x_bottom_window_length := 11; ! Default length of bottom window1=vte$x_top_window_length := 11; ! Default length of top windowCvte$x_choice_window_length := 6; ! Default length of choice windowtAvte$x_maximum_windows := 2; ! Maximum number of windows supported18vte$x_first_line := 0; ! Current line from previous run;vte$x_first_column := 0; ! Current column from previous runt-vte$x_last_line := 0; ! Current line on exitt1vte$x_last_column := 0; ! Current column on exit2Ivte$x_command_index := 1; ! Index of next character to process in commande3vte$x_command_length := 0; ! Length of command lineiMvte$x_next_repeat_count := 0; ! Stacked repeat count for nested command filesGvte$x_command_index := 0; ! Index into vte$x_command_line while parsing 9vte$x_command_length := 0; ! Length of vte$x_command_line@vte$x_column_width := 0; ! Width of each column in choice bufferBvte$x_how_many_columns := 0; ! Number of columns in choice display@vte$x_pattern_count := 0; ! Counter for match control constructsBvte$x_search_count := 0; ! Counter returned from search operationsBvte$x_ask_default := -1; ! Preset default behaviour for questions:- ! -2 : default, -1 : ask, 0 : no, 1 : yes ! Global Boolean variablesAvte$x_display := 1; ! Assume we're running from a video terminal4Evte$x_search_select := 0; ! Flag if search created a temporary select Evte$x_search_exact := 0; ! Flag if search should be temporarily exact4,vte$x_nowrap := 1; ! Don't wrap at line end,vte$x_formatter := 0; ! Formatter is active;vte$x_justify := 0; ! Flag if filling should justify liness?vte$x_left_justify := 0; ! Toggle justifying from left or rightt8vte$x_auto_case := 0; ! Disallow automatic case control?vte$x_repeated := 0; ! Current command has no numeric argument_0vte$x_pre_repeated := 0; ! Copy during prompting=vte$x_lower_case := 1; ! Allow lowercase letters to be input_=vte$x_append_register := 0; ! Append current text to register ?vte$x_append_flag := 0; ! Flag if save operation should append_Ivte$x_restore_rectangular := 0; ! Flag restoration of rectangular regionsiFvte$x_term_flag := 0; ! Flag if Return/Enter is allowed as terminatorBvte$x_repeat_flag := 0; ! Flag if repeat count is to be preserved=vte$x_learning := 0; ! Flag if learning a keystroke sequence_7vte$x_file_search := 0; ! Flag if prompting a wildcarde9vte$x_abort := 0; ! Flag if learn mode should be aborted 9vte$x_prompting := 0; ! Flag if prompting is in progress Evte$x_prompt_restored := 1; ! Flag if prompted text has been restored ?vte$x_vt200_keypad := 0; ! True if LK201 keyboard is being used_9vte$x_lse_keys := 0; ! True if LSE keys have LSE meaningFvte$x_multiple_lse := 0; ! Set to allow entry of multiple LSE commands@vte$x_review_in_progress := 0; ! True if review has been startedCvte$x_first_expand := 1; ! True until the first expand is performedi>vte$x_comment_indent := 1; ! Flag to indent comments like code@vte$x_review_in_progress := 0; ! True if review has been startedCvte$x_first_expand := 1; ! True until the first expand is performed >vte$x_comment_indent := 1; ! Flag to indent comments like code;vte$x_verify := 0; ! Flag if command file should be echoed ;vte$x_ambiguous_parse := 0; ! Flag = 1 if ambiguous command78vte$x_is_symbol := 0; ! Set if token contains no digits:vte$x_is_number := 0; ! Set if token contains only digits>vte$x_is_quoted_string := 0; ! Set if token is a quoted stringGvte$x_multiple_commands := 0; ! Set to allow entry of multiple commands Cvte$x_in_command_file := 0; ! Set if executing commands from a file5Fvte$x_valid_prompt := 0; ! Flag to show if prompting yielded something@vte$x_lse_memory := 0; ! Flag if LSE memory was used on startupFvte$x_mouse_choice := 0; ! Flag if the mouse is used for choice selectHvte$x_modified_buffers := 0; ! Flag if buffers have been set to constant! Global keyword variables8vte$x_key_prompt := 0; ! Remember key causing prompting@! Global variables connecting file type, formatter, and languageEvte$x_formatter_files := ! File extensions known as to be formattable P ".C .CBL.CLD.COB.COD.COM.DES.DOC.DTR.DUM.ENV.EXT.FOR.FTN.H .HLP.INC.INT" +O ".LIB.LSE.MAC.MAR.MMS.OPT.PAS.PDM.PEL.PPA.RND.RNH.RNO.RNT.RNX.TXT.TPU.VTE";_<vte$x_formatter_names := ! Names of corresponding formattersP ".TPU.COB.TPU.COB.FOR.COM.FOR.DOC.DTR.FOR.TPU.FOR.FOR.FOR.TPU.DOC.FOR.FOR" +O ".COB.DTR.MAR.MAR.COM.COM.TPU.DTR.DTR.MAR.RNO.RNO.RNO.RNO.RNO.RNO.TPU.DTR"; Gvte$x_language_types := ! File extensions known as to have LSE support P ".C .COB.CLD.COB.FOR.COM.FOR.DOC.DTR.FOR.PAS.FOR.FOR.FOR.C .HLP.FOR.FOR" +O ".COB.LSE.MAC.MAR.MMS.OPT.PAS.PDM.PEL.PPA.RNO.RNO.RNO.RNO.RNO.RNO.TPU.VTE";3Bvte$x_language_list := ! Unified list of supported language types3 ".C .COB.COM.DTR.FOR.HLP.LSE.MAR.PAS.RNO.TPU";%! Global arrays describing formattersevte$a_keymaps := create_array;%vte$a_keymaps{"COB"} := vte$list_for;i%vte$a_keymaps{"COM"} := vte$list_for; %vte$a_keymaps{"DOC"} := vte$list_doc;%vte$a_keymaps{"DTR"} := vte$list_for;h%vte$a_keymaps{"FOR"} := vte$list_for;%vte$a_keymaps{"MAR"} := vte$list_mar;y%vte$a_keymaps{"RNO"} := vte$list_nil; %vte$a_keymaps{"TPU"} := vte$list_for; !vte$a_formatters := create_array; #vte$a_formatters{"COB"} := "Cobol";!vte$a_formatters{"COM"} := "DCL";_&vte$a_formatters{"DOC"} := "Document";,vte$a_formatters{"DTR"} := "Query Language";%vte$a_formatters{"FOR"} := "Fortran";r#vte$a_formatters{"MAR"} := "Macro";a"vte$a_formatters{"RNO"} := "Text";1vte$a_formatters{"TPU"} := "Structured Language";if vte$x_lse_support then7$ vte$a_languages := create_array; vte$a_languages{"C"} := "C";& vte$a_languages{"COB"} := "Cobol";$ vte$a_languages{"COM"} := "DCL";+ vte$a_languages{"DTR"} := "Datatrieve";e( vte$a_languages{"FOR"} := "Fortran";% vte$a_languages{"HLP"} := "Help"; $ vte$a_languages{"LSE"} := "LSE";& vte$a_languages{"MAR"} := "Macro";' vte$a_languages{"PAS"} := "Pascal"; ' vte$a_languages{"RNO"} := "Runoff";' vte$a_languages{"TPU"} := "VAXTPU";oendif;,! Global arrays describing buffer properties"vte$a_left_margin := create_array;'vte$a_buffer_formatter := create_array;iif vte$x_lse_support thenn* vte$a_buffer_language := create_array;endif;*! Global array used to build command menus=vte$a_menu_group := create_array(19 + 2 * vte$x_lse_support); vte$a_menu_list := create_array;!d)vte$a_menu_group{1} := "Cursor movement";w%vte$a_menu_list{"cursor movement"} :=sL "bottom/end of line/line/mark/move down/move left/move right/move up/" +N "next line/next page/next screen/next word/previous line/previous page/" +C "previous screen/previous word/scroll down/scroll up/select/" +e6 "select rectangular/skip range/start%]Z VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>l8 of line/top";!o)vte$a_menu_group{2} := "Marker commands";;%vte$a_menu_list{"marker commands"} :=r4 "find mark/insert mark/remove mark/toggle mark";!)vte$a_menu_group{3} := "Search commands";!%vte$a_menu_list{"search commands"} :=eH "count/find/find next/find previous/find reverse/set search case/" +D "set search case any/set search case exact/set search origin/" +6 "set search origin current/set search origin top";!t*vte$a_menu_group{4} := "Replace commands";&vte$a_menu_list{"replace commands"} :=. "exchange/replace/replace all/substitute";!v'vte$a_menu_group{5} := "Text movement";=#vte$a_menu_list{"text movement"} :=eN "add register/append register/cut register/include register/paste/save/" + "save register";!f(vte$a_menu_group{6} := "Text insertion";$vte$a_menu_list{"text insertion"} :=M "form feed/insert buffername/insert date/insert infile/insert numeric/" +rN "insert outfile/insert special/insert text/insert time/insert wildcard/" +9 "line feed/quote/return/space/split line/tab/umlaut";"!!,vte$a_menu_group{7} := "Formatter commands";(vte$a_menu_list{"formatter commands"} :=M "decrease indent/formatter/increase indent/indent/indent continuation/" +sE "indent less/indent more/reset indent/set flash/set flash off/" +sP "set flash on/set formatter/set formatter off/set formatter on/set match/" +! "set match off/set match on";i!w+vte$a_menu_group{8} := "Insertion control"; 'vte$a_menu_list{"insertion control"} :=lH "set case/set case lower/set case upper/set mode/set mode insert/" +B "set mode overstrike/set modify/set modify off/set modify on";!i)vte$a_menu_group{9} := "Case conversion";+%vte$a_menu_list{"case conversion"} :=_6 "capitalize word/change case/lowercase/uppercase";!$(vte$a_menu_group{10} := "Text deletion";#vte$a_menu_list{"text deletion"} :=_A "delete buffer/erase line/erase next char/erase next word/" +;K "erase previous char/erase previous word/erase start of line/remove/" +  "restore";!l(vte$a_menu_group{11} := "Exit commands";#vte$a_menu_list{"exit commands"} :=i "exit/quit";!+vte$a_menu_group{12} := "Input and output";t&vte$a_menu_list{"input and output"} :=G "append file/buffer/close file/compile/file search/include file/" +D "list buffers/read file/set wildcard/set write/set write off/" +4 "set write on/this file/write file/write range";!"+vte$a_menu_group{13} := "Terminal control";a&vte$a_menu_list{"terminal control"} :=E "bound cursor/display blanks/display control/display graphics/" +ED "display tabs/free cursor/refresh/set cursor/set left margin/" +? "set right margin/set scroll/set scroll off/set scroll on";"! )vte$a_menu_group{14} := "Window control";$$vte$a_menu_list{"window control"} :=F "change windows/next buffer/one window/other window/shift left/" + "shift right/two windows";!a5vte$a_menu_group{15} := "Tab and space manipulation";a0vte$a_menu_list{"tab and space manipulation"} :=E "center line/compress spaces/expand tabs/set tabs/set tabs at/" +;# "set tabs every/trim trailing"; !b*vte$a_menu_group{16} := "Process control";%vte$a_menu_list{"process control"} :=c "attach/dcl/spawn"; !v,vte$a_menu_group{17} := "Word manipulation";'vte$a_menu_list{"word manipulation"} :=mI "add delimiter/all delimiters/clear delimiters/fill/get next word/" +l. "set word delimiters/standard delimiters";!_5vte$a_menu_group{18} := "TPU functions and learning";t0vte$a_menu_list{"tpu functions and learning"} :=D "compile tpu/do/execute learned/execute register/execute tpu/" +G "iterate register/learn/menu/set ask/set ask default/set ask no/" +f. "set ask yes/set noverify/set verify/tpu";!c1vte$a_menu_group{19} := "Miscellaneous commands";,vte$a_menu_list{"miscellaneous commands"} :=J "help/repeat/reset journal/set journal/show/sort/store number/type/" + "what line";!oif vte$x_lse_support thent* vte$a_menu_group{20} := "LSE support";% vte$a_menu_list{"lse support"} :=$? "comment align/comment fill/define alias/erase placeholder/" +r< "expand token/get environment/goto source/language help/" +D "lse command/lse keys/lse keys off/lse keys on/next placeholder/" +@ "next step/previous placeholder/previous step/review/set do/" +7 "set do lsedit/set do vtedit/set language/set source";l !* vte$a_menu_group{21} := "SCA support";% vte$a_menu_list{"sca support"} :=oA "find symbol/find symbol declarations/find symbol references/" +n- "goto declaration/goto declaration primary";tendif;.! Global variables setting defaults at startup?vte$x_word_separators := ! Set word separators to initial valuer vte$kt_init_word_sep;t3vte$x_flashing := 1; ! Enable parenthesis flashing$?vte$x_matching := 0; ! Disable automatic parenthesis insertion--vte$x_search_case := 0; ! Non-exact searchestAvte$x_search_origin := 1; ! Preserve position on failing searcheslIvte$x_free_cursor := 0; ! Flag usage of free cursor but don't use it yet"Avte$x_indent_comments := 1; ! Indent comment lines just like codeaGvte$x_indent_cont := 4; ! Indent continuation lines more than the codea?vte$x_fortran_basis := 6; ! Write Fortran code from column 7 onoMvte$x_continuation_char := '*'; ! Use asterisk for Fortran continuation fieldkLvte$x_auto_case_enable := 1; ! Use automatic case control in some formatters@vte$x_cobol_string := '"'; ! Use quote as Cobol string delimiterIvte$x_indent_struct := 4; ! Indent Structured Language in increments of 4g4vte$x_indent_spaces := 0; ! Use Tabs to indent linesCvte$x_hot_zone_size := 0; ! Right offset where word wrap will occureDvte$x_final_message := "HERE"; ! Message to be output on terminationKvte$x_auto_goto_source := 0; ! Don't add a Goto Source after Prev/Next Step ;vte$x_do_vte := 0; ! For LSE support, use Do to invoke LSEo/! Separate setups performed by other proceduresf9vte_set_word_delimiters; ! Define word delimiter patternso endprocedure;c ! Page 3! Utility ProceduresF! If a mark is set, return the select range. Otherwise, return a rangeC! containing n items starting from the current cursor location, the0D! direction depending on the sign of n, and the item type determined! by the parameter act_mode.!n ! Parameters:r(! act_mode: Type of item to be skipped:.! 0 return n characters, 1 return n lines6! n_items: Number of characters / lines to be skippedBprocedure vte$active_range(act_mode; n_items) ! Utility procedures7local temp_range, ! Active (selected/designated) rangee0 pos, ! Intermediate storage for position2 final_pos, ! Final position after execution1 num_items; ! Local copy of input parameteron_error ! Just continue endon_error;#if n_items = tpu$k_unspecified then:$ num_items := vte$x_repeat_count; vte$x_repeat_count := 1; vte$x_repeated := 0;else num_items := n_items; endif;4temp_range := 0; ! Such that we know when we have it"if vte$x_select_position <> 0 thenF if get_info(vte$x_select_position, "buffer") = current_buffer then, if vte$x_select_position <> mark(none) then temp_range := select_range; elset8 temp_range := create_range(mark(none), mark(none)); endif;d vte$x_select_position := 0; endif;endif;if temp_range = 0 then pos := mark(none); if num_items > 0 thene if act_mode then0 position(line_begin); move_vertical(num_items); else move_horizontal(num_items); endif;$ vte$check_position(0,0);e final_pos := mark(none);n2 if final_&\ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Gpos <> beginning_of(current_buffer) then move_horizontal(-1);w endif;n- temp_range := create_range(pos, mark(none));C position(final_pos);g else if act_mode theno7 if mark(none) <> beginning_of(current_buffer) thene move_horizontal(-1); pos := mark(none); endif;) position(line_begin); move_vertical(num_items); else move_horizontal(num_items); endif;  vte$check_position(0,0);c- temp_range := create_range(mark(none), pos);; endif;endif;6! Don't return the last character of the prompt bufferif vte$x_display then/ if current_window = vte$command_window thenb8 if end_of(temp_range) = end_of(vte$command_buffer) then+ final_pos := beginning_of(temp_range);n pos := mark(none);$" position(end_of(temp_range)); move_horizontal(-1);c7 temp_range := create_range(final_pos, mark(none));c position(pos); endif;_ endif;endif;return(temp_range);t endprocedure;n ! Page 4C! Procedure for handling the last string argument in a command lineoF! when it is not a quoted string. Combines the current_token with allK! remaining tokens in the command line into the last argument, puts a quoteeE! character(" or ') before and after them, and puts a ")" on the end.:!; ! Parameters: ;! result_so_far String containing parse to date - inputs;! current_token String containing current token - input!! Implicit Inputse(! vte$x_command_line Command enteredD! vte$x_command_index Index into vte$x_command_line while parsing6! vte$x_command_length Length of vte$x_command_line! Return ValueI! result_so_far + quote + current_token + rest_of_cmd_line + quote + )o<procedure vte$add_final_string(result_so_far, current_token)>local parse_result, ! Result of parsing complete command lineD rest_of_line, ! Remainer of command line including this token: quote_mark; ! Quote mark to be used in parse_resulton_error ! Just continue$ endon_error;parse_result := result_so_far;Orest_of_line := current_token + substr(vte$x_command_line, vte$x_command_index,i6 (vte$x_command_length - vte$x_command_index) + 1);$if index(rest_of_line, '"') = 0 then quote_mark := '"';else( if index(rest_of_line, "'") = 0 then quote_mark := "'"; , else ! double the quote marks in string quote_mark := '"';;1 rest_of_line := vte$double_quotes(rest_of_line); endif;endif;Lparse_result := parse_result + quote_mark + rest_of_line + quote_mark + ")";return(parse_result);s endprocedure;n e! Page 5C! Add lines to the prompt window if a multi line buffer is insertedl! ! Parameters:r@! insert_buffer: Name of buffer to be inserted in prompt window*procedure vte$adjust_prompt(insert_buffer);local buffer_lines, ! number of lines inserted from bufferr. prompt_lines; ! length of prompt windowif not vte$x_display thenu return;nendif;<buffer_lines := get_info(insert_buffer, "record_count") - 1;if buffer_lines > 1 thenC prompt_lines := get_info(vte$command_window, "visible_length");l1 if prompt_lines < vte$k_max_prompt_lines thenc> if prompt_lines + buffer_lines <= vte$k_max_prompt_lines then: adjust_window(vte$command_window, - buffer_lines, 0); elsem5 adjust_window(vte$command_window, prompt_lines -  vte$k_max_prompt_lines, 0);f endif; endif;endif; endprocedure;t i! Page 6A! Ask the user to decide whether a certain action should be taken$!e ! Parameters: ! question: Text to ask3! default_answer: 1 - yes, 0 - no, -1 - no defaultg+procedure vte$ask(question, default_answer)e<local prompt_text, ! Text to ask including optional default) reply_text, ! Answer given by usera1 original_reply, ! The same without editingt5 return_value; ! Logical value of yes/no answert#return_value := default_answer + 2; Nif vte$x_in_command_file or (not vte$x_running) and (default_answer >= 0) then" if vte$x_ask_default >= 0 then if vte$x_ask_default = 0 then' message("Operation cancelled", 2);i endif;  return(vte$x_ask_default);w else if vte$x_ask_default < -1 thenn if default_answer = 0 thenr$ message("Operation cancelled", 2); endif; return(default_answer); endif;r endif;endif;case return_value from 1 to 3 + [1]: prompt_text := question + "? ";t1 [2]: prompt_text := question + " [no] ? ";n2 [3]: prompt_text := question + " [yes] ? ";endcase;loop) reply_text := read_line(prompt_text);u" if length(reply_text) = 0 then if default_answer >= 0 then$ return_value := default_answer; exitif; endif;! else original_reply := reply_text; change_case(reply_text, lower);: if reply_text = substr("yes", 1, length(reply_text)) then return_value := 1;e exitif; elsen= if reply_text = substr("no", 1, length(reply_text)) theny return_value := 0; exitif;o elsee> message(fao("Don't understand !AS; please answer yes or no", original_reply), 2); endif;o endif; endif;endloop;if vte$x_display theno. map(vte$prompt_window, vte$prompt_buffer); erase(vte$prompt_buffer);i update(vte$prompt_window); unmap(vte$prompt_window);pendif;return(return_value);l endprocedure;e u! Page 7K! Check whether the current position is at the start of a line, i.e. beforeiJ! the first relevant character. If this is true, formatter indent commands! will be recognized.aprocedure vte$at_start_of_line/local this_position, ! current cursor positione7 temp_range, ! the first part of the current lines9 end_range; ! position of first non-blank charactergon_error ! Just continue endon_error;+if current_window = vte$command_window then= return(0);endif; if length(current_line) = 0 then return(1);endif;this_position := mark(none);position(line_begin);.+if mark(none) = end_of(current_buffer) thenN return(1);endif;Htemp_range := search_quietly(vte$pattern_start_of_line, forward, exact);if temp_range <> 0 thenO! position(end_of(temp_range));O0 if mark(none) <> end_of(current_buffer) then move_horizontal(1); endif; end_range := mark(none); position(this_position);% if this_position > end_range then. return(0);O else return(1);O endif;else position(this_position); if current_offset > 0 then return(0);N else return(1);a endif;endif; endprocedure;p e! Page 82! Backup over whitespace. Return number of spaces.$procedure vte$backup_over_whitespace9local temp_length; ! Number of characters backed up over on_error return(0); endon_error;if current_offset = 0 then return(0);endif;temp_length := 0;:!loop ! Back up past whitespaceR move_horizontal(-1);< if index(vte$kt_whitespace, current_character) <> 0 then temp_length := temp_length + 1; exitif current_offset = 0;o else move_horizontal(1); exitif; endif;endloop;return(temp_length); endprocedure;$ o! Page 9G! Build a TPU pattern from the search argument entered by the user. TheeE! procedure recognizes the match control constructs and replaces themoI! with pattern built-ins. In order for multi line arguments to be treated"C! correctly, newlines are first replaced by a special match control;0! construct (^M) and then treated like the rest.!e ! Parameters:b(! search_target: String to find - input)procedure vte$build_targ'jlA VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>UnVet(search_target)e$local this_buffer, ! Current buffer/ this_position, ! Current cursor positiontD last_position, ! Position before movement to current position> temp_range, ! Range containing match control constructs4 this_range, ! Copy needed for anchored search2 starting, ! Flag if starting (new) pattern3 any_count, ! Counter for repeated characterst? this_char; ! Letter desginating char class to be checkednon_error set(success, on);t endon_error;this_buffer := current_buffer;this_position := mark(none);starting := 1;vte$x_pattern_count := 0;pvte$x_search_exact := 0;*position(beginning_of(vte$search_buffer));K! Check if there is anything to be replaced. If the search argument is justlJ! a simple string without match control constructs then return this string#! and don't try to build a pattern. Ktemp_range := search_quietly(vte$pattern_match_control, forward, no_exact);pOif (temp_range = 0) and (get_info(vte$search_buffer, "record_count") <= 1) thene position(this_buffer); return(search_target);endif;erase(vte$target_buffer);sposition(vte$target_buffer);(copy_text(str(vte$search_buffer, "^M"));/erase_character(-2); ! Remove trailing newlinee+! Setup everything for the replacement loopr*position(beginning_of(vte$target_buffer));#copy_text("vte$pattern_search :=");c split_line;last_position := mark(none);$! Open string before first constructKthis_range := search_quietly(vte$pattern_match_control, forward, no_exact);elast_position := mark(none);Ntemp_range := search_quietly(vte$pattern_anchored_control, forward, no_exact);if temp_range = 0 then copy_text("'");s temp_range := this_range;e starting := 0;endif;4! Replace all match control constructs with patternsloop+ ! Close string before current constructd position(temp_range);e' if mark(none) <> last_position theni copy_text("'"); endif;; ! Append current construct to pattern contructed so fare if not starting then copy_text(" + "); endif; ! Double apostrophes# if current_character = "'" then  copy_text('"'); move_horizontal(1); copy_text('"'); else4 ! Replace current construct with equivalent pattern copy_text('('); erase_character(1); this_char := current_character; change_case(this_char, upper);" erase_character(1); case this_char from 'E' to 'X'g ! ^E constructo, ['E']: this_char := current_character;$ change_case(this_char, upper);: if index("ABCDEGLMNPQRSTUVWX[", this_char) <> 0 then erase_character(1);/ ! Separate treatment for ^EM - similar to ^N" if this_char = 'M' then temp_range :=/ search_quietly(vte$pattern_negated_control,e forward, no_exact);e if temp_range = 0 then; ! ^EM and a single character copy_text("span('");# if current_character = "'" thenw copy_text("'");i endif; move_horizontal(1);a copy_text("')"); elsee ! ^EM and a pattern1 erase_character(2);t# this_char := current_character; " change_case(this_char, upper); erase_character(1);". vte$copy_pattern(this_char, last_position, starting, 2, 1); endif;l elsec ! Any other ^E construct/; vte$copy_pattern(this_char, last_position, starting,i 1, 1); endif;i else. ! ^Edigits - a counted string of characters8 if index(vte$kt_digit_characters, this_char) > 0 then temp_range :=, search_quietly(vte$pattern_digit_string, forward, exact);) any_count := int(str(temp_range));  erase(temp_range);l if any_count > 0 then temp_range :=g3 search_quietly(vte$pattern_counted_control,o forward, no_exact);i if temp_range = 0 then( ! Sequence of the same character copy_text("any('");_' if current_character = "'" thent copy_text("'"); endif; move_horizontal(1);e, copy_text(fao("',!SL)", any_count)); else- ! Sequence of characters from a class erase_character(2);e' this_char := current_character;n& change_case(this_char, upper); erase_character(1);r2 vte$copy_pattern(this_char, last_position, starting, 1, any_count);d endif; elses. message("Sequence count not positive - " + "Ignored");s endif;e else16 message("Illegal pattern construct - ignored"); endif;s endif;# ! ^M - placeholder for newlinee! ['M']: if not starting then  copy_text("line_end + "); else copy_text("'' + "); endif; copy_text("line_begin");5 ! ^N - negate the following character or patterndF ['N']: temp_range := search_quietly(vte$pattern_negated_control, forward, no_exact); if temp_range = 0 then temp_range :=; search_quietly(vte$pattern_counted_pattern, forward,s no_exact);_ if temp_range <> 0 then erase_character(2); temp_range :=, search_quietly(vte$pattern_digit_string, forward, exact);) any_count := int(str(temp_range));  erase(temp_range);o if any_count > 0 then temp_range :=u3 search_quietly(vte$pattern_negated_control,i forward, no_exact); if temp_range = 0 then, ! Sequence of not the same character copy_text("notany('");' if current_character = "'" thenr copy_text("'"); endif; move_horizontal(1);, copy_text(fao("',!SL)", any_count)); else0 ! Sequence of characters outside a class erase_character(2);o' this_char := current_character;p& change_case(this_char, upper); erase_character(1);t2 vte$copy_pattern(this_char, last_position, starting, 0, any_count);i endif; elseo. message("Sequence count not positive - " + "Ignored"); endif;t elsee" ! ^N and a single character copy_text("notany('");d& if current_character = "'" then copy_text("'"); endif; move_horizontal(1); copy_text("')");o endif; else ! ^N and a patterns erase_character(2);" this_char := current_character;! change_case(this_char, upper);o erase_character(1);: vte$copy_pattern(this_char, last_position, starting, 0, 1); endif; ! ^S - shorthand for ^EBa5 ['S']: copy_text("any(vte$kt_not_alphabetic)");a ! ^X - shorthand for ^EXe! ['X']: copy_text("arb(1)"); endcase;c0 vte$x_pattern_count := vte$x_pattern_count + 1;. if vte$x_pattern_count > vte$k_max_match then8 message("Search pattern too complex - Aborted", 2);* return(str(vte$search_buffer, "^M")); endif;S< copy_text(fao(" @ vte$x_match_!SL)", vte$x_pattern_count)); split_line; endif;+ ! Look for next match control construct starting := 0; last_position := mark(none);O temp_range := search_quietly(vte$pattern_match_control, forward, no_exact);s exitif temp_range = 0;6 ! Append intermediate substring between constructs this_range := temp_range;G temp_range := search_quietly(vte$pattern_anchored_control, forward,e no_exact);e if temp_range = 0 then copy_text(" + '");s temp_range := this_range; endif;endloop;.! Terminate the pattern and the last substring$position(end_of(vte$target_buffer));move_horizontal(-1);copy_text(';'); #if mark((e VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>denone) <> last_position thent move_horizontal(-1); copy_text("'");o position(last_position); copy_text(" + '");endif;>! Finally build the pattern from the string constructed so farset(success, off);execute(vte$target_buffer);=set(success, on);;position(this_buffer);return(vte$pattern_search); endprocedure;_ m! Page 10iF! Ring the bell by giving an empty message with proper message settingprocedure vte$cancel6local old_type; ! Old setting of message action type4old_type := get_info(system, "message_action_type");set(message_action_type, bell);amessage(vte$kt_null, 2);if old_type <> bell then' set(message_action_type, old_type);cendif; endprocedure;i ! Page 11aK! Used before issuing window/buffer manipulation commands. Returns true ifeE! the current window is the message window, or the command window, insD! which case we may not want to do the command. In these cases, theE! cursor is repositioned to either the main window or the top window,_G! depending on the value of vte$x_number_of_windows. This helps people_5! who accidentally get stuck in one of these windows. procedure vte$check_bad_windowif vte$x_display thenf0 if current_window <> vte$command_window then& message("Leaving command buffer", 2); vte_next_buffer;; vte$x_key_prompt := last_key; vte$execute_key;_ vte$x_key_prompt := 0;e else vte$x_valid_prompt := 0;t vte$x_multiple_commands := 0; vte$x_multiple_lse := 0;n vte$exit_command_window;l vte$x_repeat_count := 1;  vte$x_repeated := 0;l vte$x_key_prompt := 0;w vte$x_compiled_program := 0;b position(vte$x_this_window);o3 message("Function not allowed in this window", 2);n endif;endif; endprocedure;n )! Page 12nO! Check if there is a Q-register associated with the letter given as parameter;iI! if there is one, return it, otherwise create a new buffer, associate itM! with the letter and return it. If the parameter is no letter, return false. !d ! Parameters:t(! buffer_name: Letter indicating buffer'procedure vte$check_buffer(buffer_name)r.local loop_buffer; ! Candidate for buffername2if index(vte$kt_cap_letters, buffer_name) > 0 then$ change_case(buffer_name, upper);. buffer_name := "$REGISTER_" + buffer_name;A loop_buffer := get_info(buffers, "find_buffer", buffer_name);c if loop_buffer = 0 thenn= loop_buffer := vte$init_buffer(buffer_name, vte$kt_null, 0);d endif; return(loop_buffer);else% message("Illegal buffername", 2);p return(0);endif; endprocedure;o t! Page 13 G! For formatters with automatic case control, check whether the currentnH! character should be entered in upper or lower case by setting the flag+! vte$x_lower_case to an appropriate value.iprocedure vte$check_case/local this_position, ! current cursor positiond7 temp_range, ! range containing case control chard6 comment_char, ! first character of current line3 trigger_chars; ! characters controlling caseion_error ! Just continuex endon_error;-! Check whether we are in a true comment line this_position := mark(none);position(line_begin);'"comment_char := current_character;!change_case(comment_char, upper);"5if index(vte$x_start_comment, comment_char) <> 0 theneE if (vte$x_formatter_name <> "FOR") or (index(vte$x_start_comment,l; comment_char) = 0) or (length(current_line) <= 1) then  vte$x_lower_case := 1;  position(this_position);  return; endif; if comment_char = 'C' then move_horizontal(1);< if index(vte$x_special_comment, current_character) = 0 then vte$x_lower_case := 1;n position(this_position); return; else  move_horizontal(1); endif;p else move_horizontal(1); endif;elseF ! Check for Cobol comment - no need to continue if in such a thing( if vte$x_formatter_name = "COB" then3 if length(current_line) >= vte$x_indent_basis thenr- move_horizontal(vte$x_indent_basis - 1);n4 if current_character = vte$x_start_comment then vte$x_lower_case := 1; position(this_position); return;e endif;t endif;b endif;endif;H! Check for string delimiters and start of inline comments in statementsvte$x_lower_case := 0;9trigger_chars := vte$x_comment_char + vte$x_string_delim;rloopJ temp_range := search_quietly((any(trigger_chars) | line_end), forward, exact); exitif temp_range = 0;5 exitif beginning_of(temp_range) >= this_position;  position(temp_range);e2 if current_character = vte$x_string_delim then* vte$x_lower_case := 1 - vte$x_lower_case; else if not vte$x_lower_case thend vte$x_lower_case := 1;e exitif; endif;e endif; move_horizontal(1);e' exitif mark(none) >= this_position;eendloop;position(this_position); endprocedure;  a! Page 14fC! Procedure to ensure that the prompt range is not destroyed and to0K! re-adjust the cursor position, if necessary. If the current window is the K! prompt window, check that a move did not position into the prompt string;wG! move to a position after the prompt. If the current window is not thetH! prompt window, remove any memory of a possible search range or text toI! be restored, and, if the last movement was a vertical one, readjust the F! horizontal position to allow for tabs, and remember the new vertical ! position. !n ! Parameters:33! restore: Flag if prompt may have to be restored:;#! 0 - last operation was a move(,! 1 - last operation was a vertical moveA! check_restore: Flag to check the validity of restore positionss4procedure vte$check_position(restore, check_restore)(local this_position, ! Current positionA temp_range, ! Range containing first part of prompt + text 0 loop_index, ! Pointer to prompt character( offset, ! Current offset in line< prompt_string; ! Prompt string with terminating blankon_error ! Just continue endon_error;if vte$x_display thenr/ if current_window = vte$command_window thenn this_position := mark(none);l offset := current_offset;. ! Return if not in the first line of a prompt1 if mark(none) <> end_of(vte$command_buffer) then( position(line_begin);; if mark(none) <> beginning_of(vte$command_buffer) thena position(this_position); return;i endif;s position(this_position);  endif; M ! Check for a position within the prompt - for delete means prompt destroyedzM temp_range := create_range(beginning_of(vte$command_buffer), this_position);p if offset = 0 thenr( if offset < length(temp_range) then offset := length(temp_range);o endif;l endif;c$ ! Position to the end of the prompt% if offset < vte$x_prompt_length theno0 position(beginning_of(vte$command_buffer));* move_horizontal(vte$x_prompt_length); else;4 if mark(none) = end_of(vte$command_buffer) then move_horizontal(-1); endif;f endif;N return; endif;endif;(! Forget an immediately preceding searchif vte$x_search_select thent vte$x_search_select := 0;i vte$x_select_position := 0;mendif;vte$x_find_range := 0;vte$x_pre_find_position := 0;vte$x_check_position := 0;! Forget rectangular restore!if vte$x_restore_rectangular thene# vte$x_restore_rectangular := 0;e if check_restore then vte$x_restore_start := 0; vte$x_restore_end := 0; vte$x_restore_position := 0; endif;endif;! Forget LSE operationsoif vte$x_lse_support t) T_ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>wthen8 vte$x_expand_token := 0;! vte$x_erase_placeholder := 0; 0 ! Restore correct key map list, if necessaryM if (not get_info(current_buffer, "system")) and (get_info(current_buffer,+ "key_map_list") = "TPU$KEY_MAP_LIST") thenH set(key_map_list, vte$a_keymaps{vte$x_formatter_name}, current_buffer); endif;endif;9! Don't append on save operations if the cursor was movedtvte$x_append_flag := 0; %! Forget any restore after a movementeif check_restore thene$ if vte$x_restore_start <> 0 then if vte$x_restore_end <> 0 then7 if mark(none) <> beginning_of(current_buffer) thenc move_horizontal(-1); this_position := mark(none); move_horizontal(1);c elsen this_position := mark(none); endif;nA if (mark(none) <> vte$x_restore_start) and (this_position <>  vte$x_restore_end) then  vte$x_restore_start := 0;^ vte$x_restore_end := 0;e vte$x_restore_position := 0; endif;  endif; endif;endif;+! Calculate the correct horizontal position if restore = 1 then 8 offset := get_info(current_buffer, "offset_column");( if offset > vte$x_offset_column then loopt move_horizontal(-1);e9 offset := get_info(current_buffer, "offset_column"); * exitif offset <= vte$x_offset_column; endloop;  else% if offset < vte$x_offset_column then loop,/ exitif current_offset = length(current_line);c move_horizontal(1);i- exitif mark(none) = end_of(current_buffer);e6 offset := get_info(current_buffer, "offset_column");' exitif offset >= vte$x_offset_column;t endloop;t) if offset > vte$x_offset_column thent move_horizontal(-1); endif;r endif;) endif;& vte$x_move_position := mark(none);else vte$x_move_position := 0;iendif; endprocedure;  t! Page 15 C! Check if the next higher version of a buffer exists and strip thee(! corresponding file name of its version! ! Parameters:c?! check_buffer: Buffer to be checked for a higher file versiond@! target_name: Name of corresponding file; if 0, use the output$! file associated with the buffer6procedure vte$check_version(check_buffer, target_name)/local full_name, ! File name with next versione- search_result; ! Result of file lookupron_error return(1); endon_error;1full_name := get_info(check_buffer, "file_name");aif target_name = 0 then9 target_name := get_info(check_buffer, "output_file");c if target_name = 0 thenr/ target_name := get_info(check_buffer, "name");_ endif;J target_name := file_parse(target_name, vte$kt_null, vte$kt_null, node, device, directory, name, type);endif;if full_name = vte$kt_null then return(1);endif;@if target_name <> substr(full_name, 1, length(target_name)) then return(1);endif;Ofull_name := substr(file_parse(full_name, vte$kt_null, vte$kt_null, version),2, 6);r9full_name := target_name + ";" + str(int(full_name) + 1);;*search_result := file_search(vte$kt_null);(search_result := file_search(full_name);#if search_result = vte$kt_null then return(1);elseO return(vte$ask("Higher version exists - Write to next higher version", 1));1endif; endprocedure;  l! Page 16eG! Compare two strings without looking at the case of either string, andrC! allowing abbreviations of words or omissions of directory strings)! ! Parameters:r'! string1: First string to be compared(! string2: Second string to be compared'procedure vte$compare(string1, string2)s3local str1, ! Local copy of first input parameterX4 str2, ! Local copy of second input parameter9 dirlen, ! Length of directory part of a file names1 first_word; ! String up to the first blankqC! Put everything in lower case in order to compare case-insensitiveistr1 := string1;'edit(str1, lower, trim, compress, off); str2 := string2;'edit(str2, lower, trim, compress, off);%! Fast path for simple substring case if index(str1, str2) = 1 thenx return(1);else2 ! Remove directory specification and try again dirlen := index(str1, ']');  if dirlen > 0 then9 str1 := substr(str1, dirlen + 1, length(str1) - dirlen);n if index(str1, str2) = 1 then return(1);1 else  return(0);e endif;  else' ! Compare the individual partial wordsr str1 := str1 + ' '; str2 := str2 + ' '; loop dirlen := index(str2, ' ');/ first_word := substr(str2, 1, dirlen - 1);(( if index(str1, first_word) = 1 then; str1 := substr(str1, index(str1, ' ') + 1, length(str1));t1 str2 := substr(str2, dirlen + 1, length(str2)); . if (str2 = vte$kt_null) or (str2 = ' ') then2 if (str1 = vte$kt_null) or (str1 = ' ') then return(1);h else return(0);d endif; else2 if (str1 = vte$kt_null) or (str1 = ' ') then return(0);o endif; endif; elset return(0); endif;c endloop;a endif;endif; endprocedure;; ! Page 17 ;! Procedure which helps in recognizing multi-word commands.o9! If initial_token is an initial substring of full_token,lC! then return the largest substring of full_token which contains noaI! more underscores than initial_token. Otherwise return the null string.r(! E.G., full_token = vte_set_left_margin! initial_token = vte_S! return string = vte_set! ! Parameters:s&! initial_token Prefix string - input#! full_token Entire string - input1procedure vte$complete(initial_token, full_token) Alocal underscore_index; ! Index of next underscore in full_tokene( ! that is not found in initial_tokenon_error ! Just continue endon_error;Eif initial_token <> substr(full_token, 1, length(initial_token)) then  return(vte$kt_null);endif;"if initial_token = full_token then return(initial_token);endif;Gunderscore_index := index(substr(full_token, length(initial_token) + 1, length(full_token)), '_');if underscore_index = 0 then return(full_token);nelseP return(substr(full_token, 1, length(initial_token) + underscore_index - 1));endif; endprocedure;p e! Page 18 H! Turn multiple spaces to Tabs in a given range, using given Tab spacing!t ! Parameters: /! tab_range: range to be compressed using TABs ,! tab_setting: current spacing between Tabs5procedure vte$compress_spaces(tab_range, tab_setting) =local temp_range, ! range containing spaces to be compressedt* this_mode, ! mode of current buffer/ this_position, ! current cursor positioni: replaced, ! flag to show if Tab have been replaced/ col_position, ! aktuelle Spaltenpositiono2 col_offset, ! aktuelle Anzahl Zeichen davor* n_tabs, ! number of Tabs to insert5 n_spaces; ! number of spaces replaced by Tabsron_error ! Just continueo endon_error;this_position := mark(none);.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);replaced := 0;position(tab_range);Etemp_range := search_quietly(vte$pattern_multi_space, forward, exact,c tab_range);'if temp_range <> 0 thenh9 if beginning_of(temp_range) <= end_of(tab_range) then  replaced := 1;t loop  position(temp_range);? col_position := get_info(current_buffer, "offset_column");;F n_tabs := (col_position + length(temp_range) - 1) / tab_setting - (col_position - 1) / 8;  if n_tabs > 0 then,? n_spaces := tab_setting - col_position + (col_position - 1) /^A tab_setting * tab_setting + 1 + (n_tabs - 1) * tab_setting;p er*04 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>]ase_character(n_spaces); copy_text(ascii(9) * n_tabs);c; ! Restore old position - previous marker has been shifted$2 if beginning_of(temp_range) = this_position then move_horizontal(- n_tabs);" this_position := mark(none); move_horizontal(n_tabs); endif; endif;S" position(end_of(temp_range)); move_horizontal(1);> tab_range := create_range(mark(none), end_of(tab_range));C temp_range := search_quietly(vte$pattern_multi_space, forward,  exact, tab_range); exitif temp_range = 0;r9 exitif beginning_of(temp_range) > end_of(tab_range); endloop;t endif;endif;position(this_position);set(this_mode, current_buffer);preturn(replaced);i endprocedure;a o! Page 19d!J! For ^E match control constructs, build a partial VAXTPU pattern from theJ! construct and insert it as text into the target buffer; vte$build_target&! will build a pattern from this text.!f ! Parameters:r9! this_char: letter desginating char class to be checkedi>! last_position: Position before movement to current position+! starting: Flag if starting (new) pattern;7! check_for: If 0, "notany"; if 1, "any"; if 2, "span"o-! any_count: Counter for repeated characters(Iprocedure vte$copy_pattern(this_char, last_position, starting, check_for,p any_count)/local this_position, ! current cursor positiont2 register_name, ! Letter indicating register> register_string, ! String containing all register names= register_prefix, ! String prefixing all register namese8 temp_range, ! range containing end of TPU pattern> not_flag, ! text to distinguish between search options9 any_flag, ! text representation of repeat counter 1 buffer_name; ! name of register to be usedeon_error ! Just continue endon_error;!! Setup pattern building built-inwcase check_for from 0 to 2 [0]: not_flag := "notany";t [1]: not_flag := "any"; [2]: not_flag := "span";eendcase;+if (any_count > 1) and (check_for < 2) then' any_flag := fao(",!SL", any_count);oelse any_flag := vte$kt_null;endif;O! ^E[ - process a list of characters, doubling any apostrophes and checking forv! the closing ]fif this_char = '[' thenv this_position := mark(none);& copy_text(fao("!AS('", not_flag)); loop9 temp_range := search_quietly(any("]'"), forward, exact);k if temp_range = 0 thene) position(end_of(vte$target_buffer));l move_horizontal(-1);l exitif; elsee position(temp_range);$ if current_character = "'" then copy_text("'");y move_horizontal(1);c elseg erase_character(1);t exitif;n endif;a endif;i endloop;& copy_text(fao("'!AS)", any_flag));else" case this_char from 'A' to 'X' ! ^EA - any letter A...Z a...zaE ['A']: copy_text(fao("!AS(vte$kt_letters!AS)", not_flag, any_flag));  ! ^EB - any non-alphanumeric,@ ['B']: copy_text(fao("!AS(vte$kt_not_alphabetic!AS)", not_flag, any_flag));f+ ! ^EC - any symbol constituent A...Z $ . _tC ['C']: copy_text(fao("!AS(vte$kt_symbol_characters!AS)", not_flag,a any_flag));a ! ^ED - any digit 0...9B ['D']: copy_text(fao("!AS(vte$kt_digit_characters!AS)", not_flag, any_flag)); = ! ^EE - the next character exact, without any interpretationg* ['E']: copy_text(fao("!AS('", not_flag));! if current_character = "'" theno copy_text("'");f endif; move_horizontal(1);d$ copy_text(fao("'!AS)", any_flag));' ! ^EGq - any character in Q-register q ' ['G']: this_char := current_character;e change_case(this_char, upper); erase_character(1);i- buffer_name := vte$check_buffer(this_char);h if buffer_name <> 0 then> if beginning_of(buffer_name) <> end_of(buffer_name) then8 temp_range := create_range(beginning_of(buffer_name), end_of(buffer_name));+ copy_text(fao("!AS('!AS'!AS)", not_flag,n# str(temp_range), any_flag));m endif; endif;0 ! ^EL - any line terminator A ['L']: copy_text(fao("!AS(vte$kt_line_separators!AS)", not_flag,; any_flag)); 0 ! ^EN - any supplemental (multinational) letterB ['N']: copy_text(fao("!AS(vte$kt_multi_characters!AS)", not_flag, any_flag));n= ! ^EP - any TPU pattern - insert it until the delimiting ^EP0 ['P']: copy_text("(");t split_line;R9 temp_range := search_quietly("^EP", forward, no_exact);  if temp_range <> 0 then  position(temp_range);= erase(temp_range); split_line;  else* position(end_of(vte$target_buffer)); endif; copy_text(")");pG ! ^EQq - the contents of Q-register q - copy it into the target buffer ' ['Q']: this_char := current_character; change_case(this_char, upper); erase_character(1);v- buffer_name := vte$check_buffer(this_char);c if buffer_name <> 0 then> if beginning_of(buffer_name) <> end_of(buffer_name) then copy_text("'"); this_position := mark(none);t copy_text(buffer_name); append_line;n copy_text("'"); position(this_position);_ endif; endif;+ ! ^ER - any alphanumeric A...Z a...z 0...9;? ['R']: copy_text(fao("!AS(vte$kt_alpha_numeric!AS)", not_flag,  any_flag));r) ! ^ES - any sequence of blanks and  ['S']: if check_for > 0 then_+ copy_text("span(vte$kt_whitespace)");l else- copy_text("notany(vte$kt_whitespace)");g endif;G ! ^ET - any sequence of characters - unanchor next part of the patterng# ['T']: copy_text("unanchor + ''"); ; ! ^EUq - the ASCII character whose code is in Q-register qx+ ['U']: register_name := current_character;e erase_character(1);e$ change_case(register_name, lower);% register_prefix := "vte$register_";7 if index(vte$kt_low_letters, register_name) <> 0 thent% register_string := vte$kt_null;oA register_string := expand_name(register_prefix, variables);e* change_case(register_string, lower);7 register_name := register_prefix + register_name;s7 if index(register_string, register_name) > 0 thenm. execute("vte$x_arg_2 := " + register_name);. if (check_for = 1) and (any_count = 1) then3 copy_text(fao("'!AS'", ascii(vte$x_arg_2)));r elseo/ copy_text(fao("!AS('!AS'!AS)", not_flag,r# ascii(vte$x_arg_2), any_flag));l endif;t else copy_text("arb(1)"); endif; else4 message("Invalid register name - ignored", 2); copy_text("arb(1)"); endif;# ! ^EV - any lowercase letter a...zd= ['V']: copy_text(fao("!AS(vte$kt_low_letters!AS)", not_flag,n& any_flag)); vte$x_search_exact := 1;# ! ^EW - any uppercase letter A...Zo= ['W']: copy_text(fao("!AS(vte$kt_cap_letters!AS)", not_flag,& any_flag)); vte$x_search_exact := 1; ! ^EX - any character. ['X']: copy_text(fao("arb(!SL)", any_count)); endcase;endif; endprocedure;a r! Page 20 J! Insert text with the option of later removing it; the text may be eitherI! a string or a buffer. This operation erases the restore buffer and putsy*! marks at both ends of the inserted text.!d ! Parameters:_#! copy_string: Text to be insertedc.! n_times: Number of times to insert the text-procedure vte$copy_text(copy_string; n_times)c;local string_length, ! Number of characters to be insertedn$ this_buffer, ! Current buffer* this_mode, ! Current mode of buffer; temp_range, ! Range containing string to be inserted1 num_times, ! Local copy of input parametere n; ! Iteration count#if n_times = tpu$k_u+7 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>nspecified then_ if vte$x_repeated then! num_times := vte$x_repeat_count; vte$x_repeat_count := 1;p vte$x_repeated := 0;: else num_times := 1; endif;else num_times := n_times;oendif;erase(vte$restore_buffer);this_buffer := current_buffer;+this_mode := get_info(this_buffer, "mode");_set(insert, this_buffer);g.if get_info(copy_string, "type") = string then7 string_length := - num_times * length(copy_string);e n := num_times;  loop exitif n <= 0;a copy_text(copy_string); n := n - 1; endloop; move_horizontal(-1);$ vte$x_restore_end := mark(none);' move_horizontal(string_length + 1);;else ! Insert a buffer copy_text(' ');: move_horizontal(-1);& vte$x_restore_start := mark(none); move_horizontal(1);r if num_times > 0 thenf n := num_times; loope copy_text(copy_string); n := n - 1; exitif n <= 0;t append_line;i endloop; move_horizontal(1);) if mark(none) = end_of(this_buffer) then$ append_line;; move_horizontal(-1);e else  move_horizontal(-2);e endif;t endif;$ vte$x_restore_end := mark(none);" position(vte$x_restore_start); erase_character(1);)endif;"vte$x_restore_start := mark(none);position(vte$x_restore_end);move_horizontal(1);fset(this_mode, this_buffer);;! Forget the range found by an immediately preceding search$vte$x_pre_find_position := 0;avte$x_check_position := 0;vte$x_move_position := 0;vte$x_restore_rectangular := 0;hvte$x_append_flag := 0; if not vte$x_search_select thene return;rendif;if vte$x_display thenz/ if current_window = vte$command_window thene return; endif;endif;vte$x_search_select := 0;evte$x_select_position := 0;mvte$x_find_range := 0; endprocedure;i o! Page 21tD! Procedure to create a new buffer and map it to the current window./! Returns the created buffer, or zero if error.e!f ! Parameters: ?! actual_file_name: Name of file to be read into the new buffer.! map_window: Flag if buffer should be mappedA! buffer_with_file: Flag if a file should be read into the buffermKprocedure vte$create_buffer(actual_file_name, map_window, buffer_with_file)f#local new_buffer, ! Buffer createds( buffer_name, ! Name of new buffer2 buffer_type, ! File extension of new buffer6 buffer_file_name, ! Name of file for new buffer5 outfile_name; ! Name of associated output filecon_error [tpu$_dupbufname]:) message(fao("Buffer !AS already exists",t? substr(buffer_name, 1, vte$k_max_buffer_name_length)), 2);t return(0);e [otherwise]: set(timer, off, vte$kt_null); endon_error;,! Remove possible asterisks from file searchKbuffer_name := file_parse(actual_file_name, vte$kt_null, vte$kt_null, name) - '*';Kbuffer_type := file_parse(actual_file_name, vte$kt_null, vte$kt_null, type)s - '*';)buffer_name := buffer_name + buffer_type; '! Find the file to read into the bufferiif buffer_with_file then@ new_buffer := get_info(buffers, "find_buffer", buffer_name); if new_buffer <> 0 then2 if get_info(new_buffer, "record_count") <> 0 thenI buffer_name := read_line("Type a new buffer name or press Return " +l "to cancel: ");e& if buffer_name = vte$kt_null then& message("No new buffer created", 2); return(0); endif;f new_buffer := 0; endif;t endif;1 buffer_file_name := file_search(vte$kt_null);a6 buffer_file_name := file_search(actual_file_name);* if buffer_file_name = vte$kt_null thenG if (not vte$x_running) and (get_info(command_line, "create") = 0) thenaI message(fao("Input file does not exist: !AS", actual_file_name), 2);i exit; endif;<' if buffer_file_name = vte$kt_null then)A if vte$x_lse_support and (call_user(vte$k_translate_logical,l% "CMS$LIB") <> vte$kt_null) theno- lse$do_command("Goto File " + buffer_name);"> new_buffer := get_info(buffers, "find_buffer", buffer_name); if new_buffer <> 0 then=< vte$x_input_file := get_info(new_buffer, "file_name"); endif; elsee: message(fao("File !AS not found", actual_file_name), 2); endif;n if new_buffer = 0 thenu+ new_buffer := create_buffer(buffer_name);t elseu position(new_buffer);e! set(modified, new_buffer, off);e endif;o endif;i else if new_buffer = 0 thena% set(timer, on, "...reading..."); ? new_buffer := create_buffer(buffer_name, actual_file_name,r vte$default_buffer);" set(timer, off, vte$kt_null); elsei position(new_buffer);% set(timer, on, "...reading...");r! read_file(actual_file_name); " set(timer, off, vte$kt_null);( position(beginning_of(new_buffer));$ set(modified, new_buffer, off); endif; endif;J outfile_name := file_parse(actual_file_name, vte$kt_null, vte$kt_null,& node, device, directory, name, type); if vte$x_lse_support thent position(new_buffer);" lse$do_command("Set NoLanguage"); endif;/ set(output_file, new_buffer, outfile_name);i,! Create a buffer without looking for a fileelse- new_buffer := create_buffer(buffer_name); endif;+set(eob_text, new_buffer, "[End of File]");tif vte$x_display thenr; set(margins, new_buffer, 1, get_info(screen, "width") -m vte$k_default_right_margin);delse5 set(margins, new_buffer, 1, vte$k_narrow_window); endif;;vte$a_left_margin{new_buffer} := vte$k_default_left_margin;e+if get_info(command_line, "read_only") then  set(no_write, new_buffer);endif;$if map_window and vte$x_display then$ map(current_window, new_buffer);else position(new_buffer);tendif;return(new_buffer);1 endprocedure;r t! Page 22rC! Move the selected rectangular region into a buffer and optionallyfE! delete it. If the current mode is Overstrike, insert blanks for the;! deleted text.e!t ! Parameters:"! mode: Flag: 0 to save, 1 to cut.! save_buffer: Name of buffer to cut/save into0procedure vte$cut_rectangular(mode, save_buffer)7local left_border, ! left border of rectangular region 9 right_border, ! right border of rectangular regiono- rect_width, ! distance between borders ; temp_range, ! range containing one line of rectangleuC to_line_end, ! flag if current range extends to the line endr8 this_offset, ! current horizontal cursor position@ start_position, ! position of upper left corner of region? end_position, ! position of lower right corner of regione9 left_position, ! temporary position on left borderh; right_position, ! temporary position on right borderi/ this_position, ! current cursor positionf$ this_buffer, ! current buffer8 num_spaces, ! number of spaces needed for padding1 tab_flag, ! flag if region contained Tabsi9 first_line; ! flag if copying first line of regionnon_error ! Just continuel endon_error;3! Find out the corners and borders of the rectangle)this_position := mark(none);this_buffer := current_buffer;Kif (vte$define_rectangle(tab_flag, this_offset, this_position, left_border,B right_border, rect_width, start_position, end_position) = 0) then return;aendif;;! Move/copy the rectangular region into the selected buffertposition(save_buffer);erase(save_buffer); left_position := start_position;position(left_position);first_line := 1;! Do it one line at a timeloop8 ! Determine number of padding spaces for short lines/ if length(current_line) ,%z fCb5Z vIMS\I\,>o}gZNlCYq)~_?KPt?-qOvd,J"Q$Q mODw_ 'B p?bmgo/2w'i! #TVyb{;dTSqNHNqzeww?^lg6.ssZ.Q JgwNk4k9B4I^]S {GZ0 ee"KW]\GcE$Zo?){ua9~~LO$w$^D;im0X>MZV0j\cPh==U>D7j&ol%I XIIWZLb?[9 aMnB,bw,7C Q gyKTk>M.~TB?Bh3KfJompgKB9Q9C/D,%-T>z7m+lsS_l_a;hrOMW\|@p\ GENr{ P8"w+6C%Et8X~Jw8TFcW| Z=jWYk d8z{*^fw~?WFL*5i:7RZQIyP'_^UxYxFT g#UbmB< 0F j-MyQ*'?}2 UU@Iz* 8/xO['u5Zd}-]x)LHIzKH Li}4k5wFo&D 4P/;Q.ppcC+Ej$`r]vS) + ]dfF\>'sCRN$ 80,mkII L~&/FZ-'6D{g]aWsukvM>v}T cZte%5iyl*o3R^#JRGW&EM4g;y VAUqw!h/IcP>@~-3D@XB<TO*VJMo`=y!k=7$_63t)#e0AQ^/X th\ >0>v XB:UCa\Iq"+2X9tt-0 xV0 QCpqq/Ml2>7i5{ME2>>We[|UK24/M 3c4BZVR-sI13Z B{)xu[h&4JBc%,~ %_jJ!BJk ^6Q8~M,G,f1FbG8~_5)ZPShf MjAVqAZi"W7{,1]IXd{ ^tR /kxwOi^X41^E GCjm7G?'N'dD*0*Z218UIpv;vK j-6Goe!9clJ W9=0t3aV cB` "n*BO Q5O>LV#c/b%g3k JWVB3Q=*c>U2[cV+ld3 M.WTYu++B;@ Zmlb[Xi;0$R D)yC|[.Cl[O InPCz'Au+TNZ v LIUKY?cNt?K@#i_]~mjNZW^#ud?V>h ,&^>R+:we{)[R /p2] #t< kDZ~G2il{?rqyL0, H[/@Z$]fMl&{E)ok$O`akA}  `.TFKVtz: q4*QBf^Vuz0mJb3hOaQ?2*Q39u1tw9uG A835[\.;[t~%:<6UJ0(xRfR+Ei(p 5.*c<zUs6^%$|P?UE2*pem9aka$ B!= qFTB;OQB lacQ\][wZ DOJ)1?LSYCs)8g2yW!H>,w"O\^l-w/#,=nD&B= G u/n{_QB'&El),GD() MG ?A]o&kL3aXA@V_n'm#b,%z*}3./)^~\L?d=}5N\fm'0c uRzDx#e,yJ &|X.Ca^1X?9pn _N[!F1;d,@.A d"wgp I1ILF< weRL &5rhhN+ofPZ_M *g EHR,v T:h8m?,P" %R8u_rYZYj CeAXLL|ZTg1oz\31*/g_j@t'LK'-Kg-QLA-txk*^i&=WN,+@6 $Vo$e^() >p{`qT]uJU}NspSUqg6l5#I3 E*2H*3#A`6[cK}~U<)'NlseQV[DW_qt{&ro %oG^B^tI-JMg\ O)St>xEw#jFW: (=60S\_C7+d7@d]Z`d[^K>p\aB2Ff?w/jZ$@++7g-+1NyTOPwJ*oa qR=;u17twSC Y =fWNB/<;1a~]KF^'/Wc.~ePt_;jBVaVD=[Q]9^1\@EbwNB43CeQDsaQDA&_*N "RiM% V@="4[mQ<(W;K]V_Gez\oAF|5~qzG<1-1J{r jX ElYF^GjPLsP} |9TC;2D9sv"`_]Y ^*(U6" D+K<~!U~*n`_IMN8~B*00O{N2ImaRQ``g Tlyuq %) YR.pj2Zf15( +)k4h m=Q$R*jhx]GMQn[-MwV4*ow' kT8pEgzIT:pY[-yr@\88n2%*Vjk(U$qxDXQt=STgWY_|&tGGGRO0W:Hu2s Ks=9b@6 MapuSF95T,h[\5S>>T=dCXGy\:0ELDq{g2X~3Gl|yl(RAR'e{< "D] [@QiqvM,Z*b4M 9GD*e1D.e)72  7 O C "|=dDD0#)kl$Gnu9Q*xX.:m 795I{`+7(; WqVB/n y0(\N VIe #+\&#-=:qNSh)OZg* KVZ'J s|K`|,il`SP(sSvb> %sr:.Qik+"uz +@3JlB!l7z{)OB>kc\AKk;KKX,K\h ;Qf E=(J U)ogiGxO'10F\.O7f}i}x>Kx e-KUV[e{|MMO ;RVRmxSDDJ13y~ZcXC"k}wvw I&D^XZ&:f*F|P(3}9 <c`buI94`O{oZW=+,?m9jM\A!# WTIk4HedT CqF*D*36%u2Q#; Mi"HvLjQ_/eTV\,sU0 gCs]5hGv#x jJz5;@SdXxKF'_RJ $+P<2?=X]N3J7`AjxyM! V+C-D6uSc7KF^val :yKf>>wB$-fB K(3j'NW>'7a>&FK-T:0 b'H gdl#7Ue;\xjXHQ'd [n5t~A\kQ>'YKDI=X1 5C&<3xQ%W JXot&YBR ek]f &,/(cQUu?;p =5"q,Q'[ kC2{[Fb&Xr\[hp:bY-lC$yjRV?nVADZ]>#Cl|Z~b]Hy\f0X@@ 3J:\SWx'e'o,qVm.8YjF-d/\&r-f . cd8T4!'Ej8i'4J ])lLI0X+Q8x$cK(aZfv'pO{]FZU+CaD#Gq2ubor9=Xp@ d! y=4[[hF`5@5g}`!D!>i]Q>XCi\|%y,tXaqCNUB@FDVn\v%ph7e]@WPjXTw5D :fxR~3S JR77Z[m@?9xg _PN,k7F8:8=[`lVh:[m {A|Lq"vgjVSMe!wkp) \jSHv|\X e.AG>bslSdd#A_ {?R ^){ 6k&Tp2VFEE|jBV96>zT5 Pj-1fBko+n7eehi^i Uo]|Blg+3 $z` T2rElp!KoOV}o {_1^nK _oV,P{q M9)X;D2_f;_T7'CJS]>  Rc5Ece(!dO3}&)7ibs=dLDK SJOnN/BCa@4Dx :Gc0 *5 lfsS,A`f9p=\ )1%B_sXSs@4)'.j>*,< tj##>  U{RicHo-*I1\EM&Gz=_J@ ~Vy /l[g|ZR~_]%&tu\3+MComf +Gu8(O]wDj.f%nqkrx`,_ C2V9&,~|hucd-k;+sB+z^RMfZC R,YNHv3I~GY) Isa <"w5x});Lait X?4Xsrj9 b#d=Y"EJB`Qr0{W snGB';+c)n+9P[+r[.\zBQCb}";tm#mf(S?2j?_gi|gH8!# gk)o|xK_"o9wH%^YrQLt`0rDq ;@/MMO/iw.1*N[kW7|;e(xG&\3U#a8,.v:p~u QV"Mn~bLN>bV G[L{\S3A[\-j`qL\A|,xj0>S0QD$b1]w8xS77|\ m$x$aE<6;U,; k|b}pm(~jLd"_![?MQz@qn,?.d ]H~N<$^3j Ls:}9}Q >:%"uo <?H Ik1UR! FS2#0tUZO!+ e\p;F\j JR`H#a.5! C@b r:qMNB(Q`JEyCX/r&{:ihYxWFUY\ emZ?{vmKY 35-gOD} n"fmT#zvRa&/AS7_g AjZ5[LZX4GQ!Zd_}\>#zf%l~&2_+%.ZzdPei74% 9PSHIxq)/ +SbS0 /%.7-TE] ze1P[o]yz7 {k !+8]w1(3!8.B,$B+A9<:|-WV|/oqS5M.M ~%Tl9BWTQWBd>Qbg*s}8D.}t$@>H\7X^j_>[?yLi8\E**MS t3BS2|XrsGXq0TH-R=YekUMN*%B(THHQ6A )@P+M1=H@- 0i; _5[9}XP*xbzYyYm~ >Q[ZIN 3!nnG^yF:A7$jh+&q+v$yNQ['[qtMp`;0aR=A>L/Eq"{y%'b""Goq ]nDUrMx8`GWtwOy$}$ 8 JQ4 YM H*l9CtbLbBM8( /wJ!Ypcuj"Et1_)A#7"XQ9{:{I/2K pfhQ6{(sg'j%=/ HN.;j#5e ,, +9KG|Iq*`)^@ZnT ^>Sy?*W1Q7q'fD7JV Q ~2,$Ho<^MTId9wiGxw$2NJQ9%_>2@f21p" {7NSbPCv ?d t$_\[ mf e \or~Gl1eEA'IaXTZRQKzxK( B:M YNU]3Z5oR ,*1"(vd{=<W+&t(BmXXE'fR'>:Z7R~XAuxt0akF! DB?M{z[f[o^=QWy\pU1X\14zvtBDvQRR8H[GqON?<&mfY= r1?a8;V3S[Z2UX |m#'/T(JGb+-|8;Cye1ktEY[#46U>qY=t{tIW{|t;tj x{L& &v]uZ/.7:dNPku7v!7!>= left_border then , if length(current_line) > right_border then! move_horizontal(rect_width);s num_spaces := 0;t to_line_end := 0; elsev% if length(current_line) > 0 then  position(line_end); 2 num_spaces := right_border - current_offset + 1; to_line_end := 1; else;! num_spaces := right_border + 1;h to_line_end := 0;u endif;  endif;? ! Append selected portion of line to target buffer, and, if in@ ! overstrike mode, replace it with blanks if a cut is performed7 temp_range := create_range(left_position, mark(none));b position(end_of(save_buffer));(> if mode and (get_info(this_buffer, "mode") = overstrike) then to_line_end := 0; copy_text(temp_range);r position(temp_range);( ! Replace original text with spaces' copy_text(' ' * (rect_width + 1));/4 ! Remove superfluous blanks inserted by padding2 if current_offset = length(current_line) then if first_line then4 move_horizontal(left_border - current_offset);+ temp_range := search_quietly(anchor +7 span(vte$kt_whitespace) + line_end, forward, exact);f if temp_range <> 0 thenr) erase_character(length(current_line));z endif; else! vte$backup_over_whitespace; , erase_character(length(current_line)); endif; endif;n# position(end_of(save_buffer));t move_horizontal(-1);r elsee if mode then( if length(temp_range) > 0 then move_text(temp_range); if to_line_end then, position(this_buffer);e split_line; move_horizontal(-1);t left_position := mark(none); if first_line then$ start_position := mark(none); endif;, position(save_buffer);r endif; else if to_line_end then1 position(this_buffer);r move_horizontal(-1);r left_position := mark(none);o if first_line thens$ start_position := mark(none); endif;  position(save_buffer);h split_line; endif; endif; elsed copy_text(temp_range); endif;  endif;t first_line := 0;r ! Pad short lines with spaces if num_spaces > 0 then  if to_line_end then move_horizontal(-1); endif;,! copy_text(' ' * num_spaces);  endif;c else8 ! Line shorter than left margin - save a line of spaces position(end_of(save_buffer));# copy_text(' ' * (rect_width + 1));s endif; ! Now go to next linet position(left_position); position(line_begin);n move_vertical(1);m/ if length(current_line) >= left_border thenl move_horizontal(left_border); else position(line_end); endif; left_position := mark(none);P exitif (mark(none) > end_position) or (mark(none) = end_of(current_buffer));endloop;&! Shift delimiting marks, if necessaryposition(start_position);t+if left_border >= length(current_line) thenu2 move_horizontal(left_border - current_offset);endif;start_position := mark(none);gposition(this_position);+if this_offset >= length(current_line) thena2 move_horizontal(this_offset - current_offset);endif;this_position := mark(none);&! Setup for possible restore operation if mode then- if save_buffer <> vte$restore_buffer then erase(vte$restore_buffer);h position(vte$restore_buffer); copy_text(save_buffer); endif; vte$x_restore_start := 0;t vte$x_restore_end := 0;n position(start_position); ( vte$x_old_rectangular := mark(none);else* vte$x_restore_start := start_position;& vte$x_restore_end := end_position;endif;vte$x_select_rectangular := 0;vte$check_position(0,0);vte$x_restore_rectangular := 1;s endprocedure;c (! Page 23 N! Execute a DCL command in the context of a spawned subprocess. If the processJ! does not yet exist, create it. In any case, send the command and receive! the results via mailboxes.!k ! Parameters: )! dcl_string: DCL command to be executedaprocedure vte$dcl(dcl_string)(:local this_position, ! Marker for current cursor position3 dcl_position, ! Start position in DCL buffer? temp_range, ! Range containing embedded newline returnedl$ this_buffer; ! Current bufferon_error [tpu$_createfail]:3 message("DCL subprocess could not be created", 2); return(0);  [otherwise]: endon_error;9if (get_info(vte$x_dcl_process, "type") = unspecified) or! (vte$x_dcl_process = 0) thenc- message("Creating DCL subprocess...", 1); F vte$x_dcl_process := create_process(vte$dcl_buffer, "$ set noon");endif;this_buffer := current_buffer;this_position := mark(none);,vte$new_window(this_buffer, vte$dcl_buffer);!position(end_of(vte$dcl_buffer));n! Process the DCL string split_line;bmove_horizontal(-1);dcl_position := mark(none);nmove_horizontal(1);_copy_text(dcl_string);if vte$x_display thenn update(current_window);eendif;$send(dcl_string, vte$x_dcl_process);.! Replace any embedded newlines with real onesposition(dcl_position);nloopO temp_range := search_quietly(vte$pattern_embedded_newline, forward, exact);v if temp_range <> 0 theno position(temp_range); erase(temp_range);s split_line; else exitif; endif;endloop;!position(end_of(vte$dcl_buffer));,if vte$x_display thenl update(current_window);t) if this_buffer <> vte$dcl_buffer then vte_other_window; endif;endif; return(1); endprocedure;t "! Page 24xD! Procedure to determine the upper left and lower right corners of a! rectangular region. ! ! Parameters: 1! left_border: left border of rectangular region 3! right_border: right border of rectangular regiono'! rect_width: distance between bordersb2! this_offset: current horizontal cursor position:! start_position: position of upper left corner of region9! end_position: position of lower right corner of regiona)! this_position: current cursor positionn*! tab_flag: flag if region contained TabsDprocedure vte$define_rectangle(tab_flag, this_offset, this_position,H left_border, right_border, rect_width, start_position, end_position)2local tab_setting, ! current spacing between Tabs: total_range, ! extended range containing the region3 select_offset; ! offset of selected positionyon_error ! Just continue endon_error;5tab_setting := get_info(current_buffer, "tab_stops");)0if get_info(tab_setting, "type") <> integer then+ message("Non standard Tab setting", 2); " vte$x_select_rectangular := 0; return(0);endif;1! Replace Tabs with spaces to get real rectangles #position(vte$x_select_rectangular);x?select_offset := get_info(current_buffer, "offset_column") - 1;eposition(this_position);=this_offset := get_info(current_buffer, "offset_column") - 1;fHtotal_range := vte$extended_range(create_range(vte$x_select_rectangular, this_position));6tab_flag := vte$expand_tabs(total_range, tab_setting);if tab_flag then' position(vte$x_select_rectangular); 4 move_horizontal(select_offset - current_offset);+ vte$x_select_rectangular := mark(none);> position(this_position);2 move_horizontal(this_offset - current_offset); this_position := mark(none);endif;0! Find out the vertical borders of the rectangleright_border := this_offset;#position(vte$x_select_rectangular);n%if current_offset > right_border thenc left_border := right_border;# right_border := current_offset;selse" left_border := current_offset;endif;+if right_border = length(current_line) then % right_border := right_border - 1;e. N VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>/{endif;)rect_width := right_border - left_border;$A! Find out the upper left and lower right corner of the rectangle].move_horizontal(left_border - current_offset);start_position := mark(none);r&if this_position < start_position then position(this_position);2 move_horizontal(left_border - current_offset);! start_position := mark(none); endif;position(this_position);/move_horizontal(right_border - current_offset);oend_position := mark(none);a/if end_position < vte$x_select_rectangular then ' position(vte$x_select_rectangular);e3 move_horizontal(right_border - current_offset);: end_position := mark(none);eendif;return(total_range); endprocedure;s ! Page 25tI! Delete a user text buffer and position into another user buffer. If theuK! deleted buffer was the only one, create an empty buffer to position into.c!a ! Parameters: $! buffer_name: buffer to be deleted(procedure vte$delete_buffer(buffer_name)8local buffer_window, ! window possibly mapped to buffer6 loop_buffer, ! buffer possibly mapped to window/ this_position, ! current cursor position0+ loop_window, ! All windows in a loopl n; ! Loop counterson_error set(screen_update, on); endon_error;Jif (not get_info(buffer_name, "permanent")) and (not get_info(buffer_name, "system")) then if vte$x_display thene= ! Re-adjust the top and bottom windows before unmapping themsB if (not vte$x_lse_support) and (vte$x_number_of_windows > 2) then= vte$x_top_window_length := vte$x_main_window_length / 2;(? adjust_window(vte$top_window, 0, vte$x_top_window_length -t. get_info(vte$top_window, "visible_length"));= vte$x_bottom_window_length := vte$x_main_window_length -_ vte$x_top_window_length;@ adjust_window(vte$bottom_window, vte$x_main_window_length -: vte$x_bottom_window_length - get_info(vte$bottom_window, "visible_top") + 1, 0);  endif;_A ! Find the windows to which this buffer is mapped and unmap thems set(screen_update, off);i/ if get_info(buffer_name, "map_count") > 0 thenv1 buffer_window := get_info(windows, "first");_ loop 3 loop_buffer := get_info(buffer_window, "buffer"); # if loop_buffer = buffer_name then$ unmap(buffer_window);; endif;- buffer_window := get_info(windows, "next");( exitif buffer_window = 0; endloop;e endif; endif; delete(buffer_name);' ! Find a new destiny for the cursori if vte$x_display theno set(screen_update, off);t n := 0; loopt2 if get_info(vte$a_windows{n}, "visible") then position(vte$a_windows{n});f exitif;l endif;  n := n + 1;( exitif n > vte$x_number_of_windows; endloop;i% if n <= vte$x_number_of_windows thene! this_position := mark(none);e# loop_buffer := current_buffer; " if not vte$x_lse_support then unmap(current_window);$ map(vte$main_window, loop_buffer);* vte$set_status_line(vte$main_window, 1); position(this_position);' vte$x_this_window := vte$main_window;e vte$x_number_of_windows := 1; elsea vte_one_window;_) vte$set_status_line(current_window, 1);e endif;r elset/ loop_buffer := get_info(buffers, "first");f loope) if get_info(loop_buffer, "system") then loop_buffer := 0;e endif; exitif loop_buffer <> 0;+ loop_buffer := get_info(buffers, "next");l exitif loop_buffer = 0; endloop;  if loop_buffer = 0 then. map(vte$command_window, vte$command_buffer); position(vte$command_window);a3 main_buffer := vte$create_buffer("$Main.", 0, 0);a if main_buffer = 0 thent set(screen_update, on);:2 message("Could not create buffer $MAIN", 2); quit;l endif; unmap(vte$command_window); loop_buffer := main_buffer;a endif;l position(loop_buffer);  if vte$x_lse_support then% if vte$x_number_of_windows = 1 thenl( map(vte$main_window, loop_buffer); else' map(vte$top_window, loop_buffer);  vte_one_window;b endif; else$ map(vte$main_window, loop_buffer);% if vte$x_number_of_windows > 2 thenb n := 2; loop delete(vte$a_windows{n}); n := n + 1;' exitif n >= vte$x_number_of_windows;f endloop;B vte$bottom_window := vte$a_windows{vte$x_number_of_windows};, vte$a_windows{2} := vte$bottom_window;2 vte$a_windows{vte$x_number_of_windows} := 0; endif; endif;, vte$set_status_line(current_window, 1);" vte$x_number_of_windows := 1; endif;u set(screen_update, on);6 ! Somewhat simpler treatment if used in batch mode else+ loop_buffer := get_info(buffers, "first");s loopo, if get_info(loop_buffer, "system") then loop_buffer := 0;i endif; exitif loop_buffer <> 0;u. loop_buffer := get_info(buffers, "next"); exitif loop_buffer = 0; endloop;L if loop_buffer = 0 then6 main_buffer := vte$create_buffer("$Main.", 0, 0); if main_buffer = 0 then. message("Could not create buffer $MAIN", 2); quit; endif;_ else  position(loop_buffer);m endif;n endif;else if vte$x_display theno set(screen_update, on); endif;A message("Permanent and System buffers cannot be deleted", 2);uendif; endprocedure; o! Page 26eG! Procedure to enable displaying of choices. Formats the choice bufferL! (which has one choice per line) into multiple choices per line, optionallyK! capitalize each choice, and add leading space to each line. Leaves cursor! in the choice buffer.k!u ! Parameters: >! message_to_display: Error message for message window - input2! make_low: Flag if strings should be lowercased:-! -1 : as is, 0 : uppercase, 1 : lowercasef<procedure vte$display_choices(message_to_display, make_low);"local total_width, ! Screen width: which_column, ! Column index used during formatting7 leftover, ! Used in computation of column widthe4 string_position, ! Index into expanded_string4 which_item, ! String for current column entry3 first_char, ! First character of this string < how_many_items, ! How many items need to be formatted/ this_position; ! Current cursor positionfon_error ! Just continuer endon_error;)if message_to_display <> vte$kt_null then # message(message_to_display, 1);lendif;I! We're executing an ambiguous command from a /COMMAND file. Just abort.{Nif ((not vte$x_running) and (not vte$x_display)) or vte$x_in_command_file then learn_abort; return(0);endif;>how_many_items := get_info(vte$choice_buffer, "record_count");if how_many_items = 0 then return;bendif;6! Optionally capitalize the items in the choice bufferif make_low > 0 then. position(beginning_of(vte$choice_buffer)); loop/ exitif mark(none) = end_of(vte$choice_buffer);e which_item := erase_line; change_case(which_item, lower);( first_char := substr(which_item, 1, 1); change_case(first_char, upper);F which_item := first_char + substr(which_item, 2, length(which_item)); copy_text(which_item); split_line; move_horizontal(1); endloop;endif;.! Add the cancel option to the list of choicesif make_low >= 0 then ( position(end_of(vte$choice_buffer)); move_vertical(-1);$ if length(current_line) > 0 then move_vertical(1); endif; which_item := vte$kt_cancel; if make_low > 0 then change_case(which_item, upper); endif; copy_text(which_item); move_horizontal(1);r) how_many_items := how_many/D+ ; VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>_items + 1;,endif;2! Get the length of the longest line in the buffer*position(beginning_of(vte$choice_buffer));vte$x_column_width := 0;loop2 exitif mark(none) = end_of(vte$choice_buffer);5 if vte$x_column_width < length(current_line) then, vte$x_column_width := length(current_line); endif; move_vertical(1);cendloop;?! Determine the number of columns (items) that can be on a line)total_width := get_info(screen, "width");e-vte$x_column_width := vte$x_column_width + 2;bAvte$x_how_many_columns := (total_width - 1) / vte$x_column_width;fPif (vte$x_how_many_columns * vte$x_column_width) > total_width then ! rounded up9 vte$x_how_many_columns := vte$x_how_many_columns - 1;hendif;"if vte$x_how_many_columns = 0 then vte$x_how_many_columns := 1;else3 if how_many_items < vte$x_how_many_columns thenl? ! Adjust for number of items < number that would fit on a line* vte$x_how_many_columns := how_many_items; else? ! Adjust for number of items > number that would fit on a line  loopc> leftover := (total_width - 1) - (vte$x_how_many_columns * vte$x_column_width);. exitif leftover < vte$x_how_many_columns;2 vte$x_column_width := vte$x_column_width + 1; endloop;c endif;endif;E! Copy the alternatives into the match buffer for selection by typingiposition(vte$match_buffer); erase(vte$match_buffer);copy_text(vte$choice_buffer);iwhich_column := 1;string_position := 1;o*position(beginning_of(vte$choice_buffer)); split_line;mloop2 exitif mark(none) = end_of(vte$choice_buffer); which_item := erase_line;r move_horizontal(-1);F if (which_column = 1) and (vte$x_column_width <= total_width) then copy_text(' '); endif; copy_text(which_item);1 if which_column = vte$x_how_many_columns then_ split_line; which_column := 1;  else< copy_text(' ' * (vte$x_column_width - length(which_item)));" which_column := which_column + 1; endif; move_horizontal(1);nendloop;$position(end_of(vte$choice_buffer));loop5 exitif mark(none) = beginning_of(current_buffer);l move_vertical(-1);$ exitif length(current_line) > 0; append_line;endloop;vte$x_ambiguous_parse := 1;l*position(beginning_of(vte$choice_buffer)); endprocedure;( g! Page 27L! Display current line in message window, with current position highlighted.procedure vte$display_line/local this_position, ! Current cursor position this_line, ! Current line- start_of_line, ! Start of current line - this_offset; ! Offset of this_position_if vte$x_display then this_position := mark(none);" this_offset := current_offset; position(line_begin);) start_of_line := mark(none); position(line_end);s9 this_line := create_range(start_of_line, mark(none));i% position(end_of(message_buffer));e copy_text(this_line);= move_vertical(-1);! move_horizontal(this_offset);l, vte$x_reverse_position := mark(reverse); position(line_end); update(message_window);t position(this_position);endif; endprocedure;u p! Page 28 *! Empty procedure to silently ignore a keyprocedure vte$do_nothing endprocedure;e ! Page 29lD! Procedure for handling quoted string. Takes the argument, doubles8! all quotation marks, and returns the resulting string.!) ! Parameters:3! string_with_quotes String being processed - inputi/procedure vte$double_quotes(string_with_quotes)a=local result_string, ! Portion of string with quotes doubledo@ rest_of_string, ! Remainder of string yet to be processed= quote_index; ! Index of double-quote in rest_of_stringdon_error ! Just continuef endon_error;result_string := vte$kt_null;i%rest_of_string := string_with_quotes;tloop. quote_index := index(rest_of_string, '"'); if quote_index = 0 thent1 result_string := result_string + rest_of_string;: exitif; elseH result_string := result_string + substr(rest_of_string, 1, quote_index) + '"';(- exitif quote_index = length(rest_of_string);s: rest_of_string := substr(rest_of_string, quote_index + 1, length(rest_of_string));_ endif;endloop;return(result_string); endprocedure; s! Page 30u"! Find the end of the current wordprocedure vte$end_of_wordt?local temp_range; ! Range from current position to end of wordoon_error; return(0); ! Suppress "string not found" error messaget endon_error;'if current_character = vte$kt_null thent move_horizontal(1);t@ if index(vte$x_word_separators, current_character) <> 0 then? temp_range := search(vte$pattern_end_of_word, forward, exact);t position(end_of(temp_range)); endif;elseB temp_range := search(vte$pattern_end_of_word, forward, exact);! position(end_of(temp_range)); endif;<if (index(vte$x_word_separators, current_character) <> 0) or' (current_character = vte$kt_null) thent move_horizontal(1);tendif;if current_offset = 0 then loop! exitif length(current_line) > 0;n move_vertical(1); endloop;endif;<if index(vte$x_word_separators, current_character) <> 0 thenB temp_range := search(vte$pattern_end_of_word, forward, exact);! position(end_of(temp_range));rendif; return(1); endprocedure;o ! Page 31xE! Determine if one of the procedure names (commands) in the choiceeB! buffer matches the token_end_pattern; if more than 1 do, then?! see if one matches the token_sub_pattern for the specified! token count.eE! The token_end_pattern is the normal token pattern with "+ line_end"tJ! appended to the end - for tokens that match other comand tokens that areE! sub or super sets of this command (e.g., set, set foo, set foo bar,! set foo bar bletch)o<! The token_sub_pattern is the normal token pattern with the@! "+ pattern_token_end" removed - for tokens that are substrings7! of other command tokens (e.g., set grid vs set grids)l#! This procedure is called when: ?! 1. There are no more tokens to parse in the command line, yet E! the choice buffer contains more than one procedure name. See ifs@! any of them match the token_end_pattern. If none is found,@! then the ambiguous commands in choice buffer are displayed.I! If more than 1, then see if any of them match the token_sub_pattern.nB! The token count has been decremented to match how many tokensE! were actually found. (token # 1 = circle in command draw circle)oH! 2. The last token gotten (via vte$get_token) is not part of a command,A! yet the choice buffer contains more than one procedure name.rA! (The last token may be either an illegal token, or a commandsB! argument.) See if any of the procedures in the choice bufferB! match the token end pattern for a token count equal to 1 less=! than the last token. If none is found, then the commandpC! is illegal. If more than 1, then see if any of them match the$! token_sub_pattern.,!i ! Parameters0! count = token pattern count to use - Input)! result = null if no match - Output ?! = procedure name matching the specified token end pattern ! Return statusc ! trueh7procedure vte$enough_tokens(endtoken, subtoken, result)olocal found_string,u search_pattern,o search_range,g number_found;ron_error ! Just continue_ endon_error;result := vte$kt_null;search_pattern := endtoken;n*position(beginning_of(vte$choice_buffer));loop2 exitif mark(none) = end_of(vte$choice_buff0a VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>N;er);< search_range := search_quietly(search_pattern, forward); exitif search_range = 0; position(search_range);1! found_string := current_line;o% number_found := number_found + 1;e7 exitif number_found > 1; ! only 1 match is allowede move_vertical(1);tendloop;if number_found = 1 then result := found_string;aelse if number_found > 1 then search_pattern := subtoken; number_found := 0;e+ position(beginning_of(vte$choice_buffer)); loop$3 exitif mark(none) = end_of(vte$choice_buffer);i= search_range := search_quietly(search_pattern, forward);; exitif search_range = 0;e position(search_range);" found_string := current_line;& number_found := number_found + 1;8 exitif number_found > 1; ! only 1 match is allowed move_vertical(1); endloop;b if number_found = 1 then  result := found_string; endif; endif;endif; return(1); endprocedure;h r! Page 32 3! Find the procedure bound to a key and execute it.dprocedure vte$execute_keyd5local key_program, ! Program bound to key to executeo9 key_letter; ! First letter of comment bound to keyf#if vte$x_compiled_program <> 0 then* key_program := vte$x_compiled_program; execute(key_program); vte$x_compiled_program := 0; return;;endif;4if get_info(vte$x_key_prompt, "type") = program then execute(vte$x_key_prompt);else8 key_letter := lookup_key(vte$x_key_prompt, comment);* if substr(key_letter, 1, 1) = ' ' then6 key_program := lookup_key(vte$x_key_prompt, program); if key_program <> 0 thent execute(key_program); endif;n endif;endif; endprocedure;; ! Page 33J! Leave the command window and restore the state before prompting started.F! This procedure will be called on normal return from prompting and on! cancelling a prompt.!procedure vte$exit_command_window .local prompt_lines; ! Length of prompt windowon_error ! Just continuen endon_error;6! Expand the prompt window on a non-terminating ReturnOif vte$x_display and (not vte$x_term_flag) and (lookup_key(last_key, comment) =o " return") thenC prompt_lines := get_info(vte$command_window, "visible_length");c1 if prompt_lines < vte$k_max_prompt_lines theno( adjust_window(vte$command_window,-1,0); endif; split_line;  vte$show_first_line; update(current_window);p return;iendif;! Terminate promptingi+position(beginning_of(vte$command_buffer));w%erase_character(vte$x_prompt_length);_Ivte$x_text_range := create_range(mark(none), end_of(vte$command_buffer));,-vte$x_prompt_result := str(vte$x_text_range);t'if length(vte$x_prompt_result) = 0 thenx< if get_info(vte$command_buffer, "record_count") = 1 then erase(vte$command_buffer);s endif;endif;3! Restore environment that existed before promptingoif vte$x_display thenoC prompt_lines := get_info(vte$command_window, "visible_length");d if prompt_lines > 1 then8 adjust_window(vte$command_window, prompt_lines - 1, 0); endif; unmap(vte$command_window);' position(vte$x_pre_command_window);fendif;#position(vte$x_pre_command_buffer);f.vte$x_repeat_count := vte$x_pre_command_count;if vte$x_repeat_flag thena) vte$x_repeated := vte$x_pre_repeated;oendif;*vte$x_select_position := vte$x_pre_select;2vte$x_select_rectangular := vte$x_pre_rectangular;vte$x_pre_select := 0;vte$x_pre_rectangular := 0;rEvte$x_find_range := 0; ! Need this in order to get around mixed types#vte$x_find_range := vte$x_pre_find;e!vte$x_old_command := vte$kt_null;o"vte$x_count_prompt := vte$kt_null;M! Now re-execute the command that started prompting. It is the responsibilitydN! of this command to execute now and not to start prompting again, which might! cause a loop.uPif vte$x_valid_prompt and ((vte$x_key_prompt <> 0) or (vte$x_compiled_program <> 0)) thent vte$execute_key; vte$x_key_prompt := 0;endif;O! Now finally prompting is over - if the current command did not start it againeif vte$x_display thenw0 if current_window <> vte$command_window then vte$x_prompting := 0;. ! In command input mode, get the next command if vte$x_multiple_commands then! vte$x_compiled_program := 0;e* vte$x_key_prompt := vte$command_mode;8 vte$prompt_string("VTE>", vte$vtedit_buffer, 1, 0); else(5 if vte$x_lse_support and vte$x_multiple_lse thend# vte$x_key_prompt := vte$lse_mode;n2 vte$prompt_string("LSE>", vte$lse_buffer, 1, 0); endif;c endif;n else vte$x_key_prompt := 0;_ endif;endif; endprocedure;u r! Page 34e9! Turn Tabs to spaces in a range, using given Tab spacingf!$ ! Parameters: )! tab_range: Range to be freed from Tabsd,! tab_setting: Current spacing between Tabs1procedure vte$expand_tabs(tab_range, tab_setting)s8local temp_range, ! Range containing Tab to be expanded* this_mode, ! Mode of current buffer/ this_position, ! Current cursor position : replaced, ! Flag to show if Tab have been replaced. n_spaces; ! Number of spaces to inserton_error ! Just continueo endon_error;this_position := mark(none);.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);replaced := 0;position(tab_range);Btemp_range := search_quietly(ascii(9), forward, exact, tab_range);if temp_range <> 0 theni9 if beginning_of(temp_range) <= end_of(tab_range) theni replaced := 1;, loop  position(temp_range); erase_character(1); n_spaces := current_offset;E n_spaces := n_spaces - (tab_setting * (n_spaces / tab_setting));n/ copy_text(' ' * (tab_setting - n_spaces));l> ! Restore old position - previous marker has been shifted5 if beginning_of(temp_range) = this_position theno* move_horizontal(n_spaces - tab_setting); this_position := mark(none);* move_horizontal(tab_setting - n_spaces); endif;n< temp_range := search_quietly(ascii(9), forward, exact); exitif temp_range = 0;u9 exitif beginning_of(temp_range) > end_of(tab_range);e endloop; endif;endif;position(this_position);set(this_mode, current_buffer);return(replaced);e endprocedure;f ! Page 35 K! Take the result of an expand_name command, and put each of the choices on J! a separate line in the choice buffer. Erase any previous choices in the?! choice buffer. Cursor is left at beginning of choice buffer.e!c ! Parameters:d0! expanded_string Result of expand_name - input0procedure vte$expand_to_choices(expanded_string)local temp_string, temp_index,d this_position;on_error ! Just continuer endon_error;#this_position := mark(free_cursor);fposition(vte$choice_buffer);erase(vte$choice_buffer);e%if expanded_string = vte$kt_null thend position(this_position); return;dendif;temp_string := expanded_string;dloop* temp_index := index(temp_string, ' '); exitif temp_index = 0;6 copy_text(substr(temp_string, 1, temp_index - 1)); split_line;sL temp_string := substr(temp_string, temp_index + 1, length(temp_string));endloop;copy_text(temp_string);s*position(beginning_of(vte$choice_buffer)); endprocedure;t n! Page 36;G! Routine to extend a given range such that the extended range includessD! the full text of the first and last lines, even if the given rangeK! starts/ends in the middle of a line (needed for operations on rectangular) ! regions)!m ! Parameters:'! original_range: 1ǧ6Z VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Ӣ Range to be extended,procedure vte$extended_range(original_range)/local this_position, ! current cursor positione0 start_position, ! start of extended range2 full_range; ! extended range to be returnedon_error ! just continueb endon_error;this_position := mark(none);position(original_range);hposition(line_begin);cstart_position := mark(none);!position(end_of(original_range));1position(line_end);t7full_range := create_range(start_position, mark(none));eposition(this_position);return(full_range);e endprocedure;; m! Page 37! Word-wrap procedure.!d ! Parameters:t<! insert_space Number of spaces to insert at the end of the! filled line%procedure vte$fill_line(insert_space) $local this_buffer, ! Current buffer0 left_border, ! Left margin of this_buffer2 right_border, ! Right margin of this_buffer; space_position, ! Marker for current cursor position $ this_column, ! Current column0 hot_column, ! Column at start of hot zone, words, ! Number of words in hot zone9 line_position, ! Previous position in current lineh0 spaces, ! Number of spaces between words3 start_of_line; ! Column at start of new liner:if vte$x_nowrap or get_info(current_buffer, "system") then" copy_text(' ' * insert_space); return;endif;this_buffer := current_buffer;.left_border := vte$a_left_margin{this_buffer};6right_border := get_info(this_buffer, "right_margin");Nif vte$x_justify or ((right_border - left_border) <= vte$x_hot_zone_size) then hot_column := right_border;xelse5 hot_column := right_border - vte$x_hot_zone_size;_endif;space_position := mark(none);16this_column := get_info(this_buffer, "offset_column");Cif (this_column <= hot_column - insert_space + 1) or (this_buffer =y vte$command_buffer) theno if insert_space > 0 then copy_text(' ' * insert_space);w endif; return;_endif;!right_border := right_border + 1;mline_position := mark(none);loop: this_column := get_info(this_buffer, "offset_column");' exitif this_column <= right_border; line_position := mark(none); spaces := 0;! exitif vte$start_of_word = 0;t) spaces := vte$backup_over_whitespace;  words := words + 1;oendloop;1! No sense splitting at the beginning of the lineh6this_column := get_info(this_buffer, "offset_column");!if this_column = left_border thent position(line_position);endif;erase_character(spaces); split_line;if vte$x_justify then( vte$justify_line;cendif;if vte$x_auto_indent <> 0 then* vte$indent_line_to(vte$x_auto_indent);endif;8start_of_line := get_info(this_buffer, "offset_column");position(space_position);y6this_column := get_info(this_buffer, "offset_column");"if this_column > right_border then if words > 1 thene if insert_space > 0 theno vte$fill_line(1); else) vte$fill_line(0); endif;  else split_line; if vte$x_justify then vte$justify_line; endif;e if vte$x_auto_indent <> 0 then(+ vte$indent_line_to(vte$x_auto_indent);o endif;a endif;elseA if (insert_space > 0) and (this_column <> start_of_line) theni copy_text(' ' * insert_space);n endif;endif; endprocedure;o u! Page 38 !eJ! Search for target in forward direction, if the repeat count is positive,K! otherwise in backward direction. Returns range if target found, otherwiser! returns false.!s ! Parameters:n%! target: String or pattern to findfprocedure vte$find(; target)8local how_exact, ! Keyword to indicate case-sensitivity- find_range; ! Range returned by search on_error ! Just continuel endon_error;! Build a new target#if target <> tpu$k_unspecified then < if (target <> vte$x_target) and ((target <> vte$kt_null): or (get_info(vte$command_buffer, "record_count") > 1)? or (get_info(vte$search_buffer, "record_count") > 1)) then * vte$x_target := vte$build_target(target); if vte$x_display then, vte$remember_buffer(vte$search_buffer); endif;i endif;endif;! Setus search parameterse if vte$x_search_select <> 0 then vte$x_select_position := 0;n vte$x_search_select := 0; endif;/if vte$x_search_case or vte$x_search_exact thenT how_exact := exact;selse how_exact := no_exact;endif;! Now perform the search&vte$x_pre_find_position := mark(none);find_range := 0;if vte$x_repeat_count > 0 then loop exitif vte$x_repeat_count <= 0;. vte$x_repeat_count := vte$x_repeat_count - 1;: if vte$x_pre_find_position <> end_of(current_buffer) then if find_range <> 0 then position(end_of(find_range));n move_horizontal(1);u endif;D find_range := search_quietly(vte$x_target, forward, how_exact); else_ find_range := 0;t endif;= exitif find_range = 0;' endloop;else# if (vte$x_find_range <> 0) thens position(vte$x_find_range); move_horizontal(-1);_ endif; loop exitif vte$x_repeat_count >= 0;. vte$x_repeat_count := vte$x_repeat_count + 1;@ if vte$x_pre_find_position <> beginning_of(current_buffer) then if find_range <> 0 then position(find_range);n move_horizontal(-1); endif;gD find_range := search_quietly(vte$x_target, reverse, how_exact); elseo find_range := 0;_ endif; exitif find_range = 0;n endloop;endif;vte$x_repeat_count := 1; ! Evaluate and return the resultvte$x_restore_rectangular := 0;oif find_range = 0 then if vte$x_search_origin then # position(vte$x_pre_find_position);e else( position(beginning_of(current_buffer)); endif; vte$x_abort := 1;_ return(0);else% if vte$x_select_position = 0 then  position(find_range);* vte$x_select_position := select(reverse); vte$x_search_select := 1; endif;/ vte$position_in_middle(end_of(find_range));r0 if mark(none) <> end_of(current_buffer) then move_horizontal(1); endif; erase(vte$restore_buffer);4 vte$x_restore_start := beginning_of(find_range);, vte$x_restore_end := end_of(find_range); vte$x_restore_position := 0; return(find_range);)endif; endprocedure;e ! Page 39eE! Procedure to determine the name of a Q-register. Returns the buffer;J! representing the Q-register. If the name is '*', returns the name of theH! current output file, and if the name is '_', returns the search string ! buffer.n!a ! Parameters:t6! append_mode: 0: alpha registers, 1: allow appending,&! 2: allow special registers * and _)! q_buffer: Name of q-register to be used 3procedure vte$get_buffername(append_mode; q_buffer) .local buffer_name; ! Letter indicating buffer$if q_buffer = tpu$k_unspecified thenN buffer_name := vte$prompt_key("Type a letter to select a register", 0, 1); if vte$x_display thent# buffer_name := ascii(buffer_name); endif;else buffer_name := q_buffer;endif;vte$x_append_register := 0;s?if (append_mode = 1) and (substr(buffer_name, 1, 1) = ':') thenn vte$x_append_register := 1;m# if length(buffer_name) > 1 thenr* buffer_name := substr(buffer_name, 2, 1); else9 if vte$x_display and (q_buffer = tpu$k_unspecified) then,$ buffer_name := ascii(read_key); endif;f endif;endif;if append_mode = 2 thene if buffer_name = '*' thenn1 return(get_info(current_buffer, "output_file"));m endif; if buffer_name = '_' thenc return(vte$search_buffer);r endif;endif; change_case(buffer_name, upper);&return(vte$check2O7 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>wH_buffer(buffer_name)); endprocedure;t c! Page 40nH! Procedure to determine the name of a formatter to be applied. The nameJ! is derived from the file type of the file name presented as a parameter.G! If this file type is found in a translation table, the formatter nameuH! is the corresponding element in this table, otherwise the empty stringJ! is returned. This technique allows to use the same formatter for several! different file types.i! ! Parameters: 6! input_file_name: File name determining the formatter;! list_names: List of extensions to be used for comparisonh8procedure vte$get_formatter(input_file_name, list_names))local n_form, ! index of file extensionn> file_type; ! padded file type determining the formatterDfile_type := file_parse(input_file_name, ".TPU", vte$kt_null, type);if file_type = vte$kt_null thent return(vte$kt_null);endif;if length(file_type) < 4 theng= file_type := file_type + (' ' * (4 - length(file_type)));vendif;2n_form := index(vte$x_formatter_files, file_type);if n_form > 0 then. return(substr(list_names, n_form + 1, 3));else return(vte$kt_null);endif; endprocedure;r u! Page 41+I! Get the contents of TPU$MEMORY - VTEDIT uses this as default input filerH! if no filespec was given. If TPU$MEMORY points to TEC$MEMORY, use that ! instead.procedure vte$get_memory(local memory, ! Contents of TPU$MEMORY: mem_range, ! To create a string from these contents8 temp_range, ! Range containing /FIND=(x,y) string2 file_name, ! Dummy variable for file search$ this_buffer, ! Current buffer/ this_position; ! Current cursor positionron_error9 message("Could not find out editor default file", 2);i set(success, on);o return(vte$kt_null); endon_error;! Use memory, if setAmemory := call_user(vte$k_translate_logical, "LSE$CURRENT_FILE");nif memory <> vte$kt_null thenn@ vte$x_first_column := int(call_user(vte$k_translate_logical, "LSE$START_CHARACTER"));> vte$x_first_line := int(call_user(vte$k_translate_logical, "LSE$START_LINE")); vte$x_lse_memory := 1;t return(memory);uendif;! Translate the logical namethis_buffer := current_buffer;;memory := call_user(vte$k_translate_logical, "TPU$MEMORY");oif memory = "TEC$MEMORY" thenn9 memory := call_user(vte$k_translate_logical, memory);aendif;L! If the logical name points to a file (by specifying the file name preceded3! by '$'), return the contents of this file instead "if substr(memory, 1, 1) = '$' then this_position := mark(none);4 memory := substr(memory, 2, length(memory) - 1);H file_name := file_search(vte$kt_null); ! Make sure nobody affects us. if file_search(memory) <> vte$kt_null thenD file_name := file_search(vte$kt_null); ! Make sure we affect nobody set(success, off);a position(vte$memory_buffer);  read_file(memory);o set(success, on); else memory := vte$kt_null;n endif;else position(vte$memory_buffer); copy_text(memory);endif;?! Find out if the memory contained a position, and interpret it(if memory <> vte$kt_null then. position(beginning_of(vte$memory_buffer));= temp_range := search_quietly(" /FIND=(", forward, exact);t if temp_range <> 0 thena position(temp_range); move_horizontal(-1);iH mem_range := create_range(beginning_of(vte$memory_buffer), mark(none)); position(end_of(temp_range)); move_horizontal(1);H temp_range := search_quietly(vte$pattern_digit_string, forward, exact); if temp_range = 0 thene return(str(mem_range)); endif;$* vte$x_first_line := int(str(temp_range)); position(end_of(temp_range)); move_horizontal(2);H temp_range := search_quietly(vte$pattern_digit_string, forward, exact); if temp_range = 0 thens return(str(mem_range)); endif;o, vte$x_first_column := int(str(temp_range)); else% position(end_of(vte$memory_buffer));c move_horizontal(-1);_H mem_range := create_range(beginning_of(vte$memory_buffer), mark(none)); endif; memory := str(mem_range);nendif;position(this_buffer);return(memory);m endprocedure;n ;! Page 42e ! Description)@! vte$get_token returns the next token in the command line orD! a null string if no more tokens. Normally leaves the cursor onE! the whitespace after a token; exception: it will leave it on the ,! character after the "@" in "@file_name"!tI! Tokens include symbols, quoted strings, and punctuation, and stringsgH! that are "none of the above." A quoted string at the end of a line/! does not have to have a final close quote.$!nI! Special case: the "@" in the @ (atfile) command. User may enter theo?! command "@file_name" which invoked vte__at_file(file_name)m!n! Implicit Inputst(! vte$x_command_line Command enteredD! vte$x_command_index Index into vte$x_command_line while parsing6! vte$x_command_length Length of vte$x_command_line! Implicit Outputs5! vte$x_is_symbol Set if token contains no digitsa7! vte$x_is_number Set if token contains only digitsn;! vte$x_is_quoted_string Set if token is a quoted stringI! Return Value! the tokenprocedure vte$get_tokent9local original_index, ! Original index into command linevA quote_char, ! Quote character being used for quoted string,. c, ! Current character in command line< closed_quote, ! True if quote_char ends quoted string@ work_token; ! Temporary string for building current tokenon_error ! Just continue endon_error;quote_char := vte$kt_null;c := vte$kt_null;uwork_token := vte$kt_null;vte$x_is_symbol := 0; vte$x_is_quoted_string := 0;vte$x_is_number := 1;sJ! Move vte$x_command_index over whitespace. Stay put if not on whitespace! when starting.loop6 if vte$x_command_index > vte$x_command_length then vte$x_is_number := 0; return(vte$kt_null);d endif;C exitif index(vte$x_token_separators, substr(vte$x_command_line,s vte$x_command_index, 1)) = 0;3 vte$x_command_index := vte$x_command_index + 1;cendloop;&original_index := vte$x_command_index;8c := substr(vte$x_command_line, vte$x_command_index, 1);C! Special case: the '_' in _at_file to prevent its use as a command_:if (c = '_') and(vte$x_uppercase_token = vte$kt_null) then return('_');endif;1! Special case: the "@" in @some_vte_command_filet;if (c = "@") and (vte$x_uppercase_token = vte$kt_null) thene: ! Move vte$x_command_index to next character after "@"3 vte$x_command_index := vte$x_command_index + 1;f vte$x_is_symbol := 1;a1 return("_at_file"); ! @ invokes vte__at_file endif;5! Special case: a sign (+,-) may be start of a numberoif index("+-", c) > 0 thenJ vte$x_command_index := vte$x_command_index + 1; ! Simply skip the sign< c := substr(vte$x_command_line, vte$x_command_index, 1);endif;.if index(vte$kt_symbol_characters, c) > 0 then vte$x_is_symbol := 1;_ loopG vte$x_is_number := vte$x_is_number and (index(vte$kt_digit_characters, c) > 0);nH vte$x_is_symbol := vte$x_is_symbol and (index(vte$kt_symbol_characters, c) > 0);_0 vte$x_command_index := vte$x_command_index + 1;3 exitif vte$x_command_index > vte$x_command_length;39 c := substr(vte$x_command_line, vte$x_command_index, 1);c- exitif index(vte$x_token_separators, c) > 0;c endloop;K return(substr(vte$x_command_line, original_index, vte$x_command_index -n original_index));endif;vte$x_is_number := 0;dEif (c = "'") or (c = '"') then !3QPd VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> Not a symbol, is it a quoted string?e vte$x_is_quoted_string := 1; quote_char := c; loop0 vte$x_command_index := vte$x_command_index + 1;3 exitif vte$x_command_index > vte$x_command_length;f9 c := substr(vte$x_command_line, vte$x_command_index, 1); if c = quote_char thene ! Check for doubled quotes_4 vte$x_command_index := vte$x_command_index + 1;7 if vte$x_command_index > vte$x_command_length then,; closed_quote := 1; ! Complete quoted string (and no more)_ exitif;t endif;)= c := substr(vte$x_command_line, vte$x_command_index, 1);m if c <> quote_char then9 closed_quote := 1; ! Complete quoted string (plus more)i exitif;h5 endif; ! Else, odd number of quote chars, loop;+ endif; ! looking for next closing quote endloop;P work_token := substr(vte$x_command_line, original_index, vte$x_command_index - original_index);t= ! Add close quote if there wasn't one due to end of line.e if closed_quote then return(work_token); else! return(work_token + quote_char);d endif;endif;.! Move vte$x_command_index to next whitespace.loop6 exitif vte$x_command_index > vte$x_command_length;C exitif index(vte$x_token_separators, substr(vte$x_command_line,c vte$x_command_index, 1)) <> 0;s3 vte$x_command_index := vte$x_command_index + 1;oendloop;Greturn(substr(vte$x_command_line, original_index, vte$x_command_index -e original_index));) endprocedure;: r! Page 43sJ! Procedure to position to a mark and, if necessary, map the corresponding! window!m ! Parameters:e"! go_to_mark: mark to position toprocedure vte$go_to(go_to_mark)r6local buffer_of_mark; ! buffer containing target mark.if get_info(go_to_mark, "type") <> marker then5 message("Selected position has been deleted", 2);e return;tendif;1buffer_of_mark := get_info(go_to_mark, "buffer");r<if vte$x_display and (buffer_of_mark <> current_buffer) then' if vte$x_number_of_windows = 2 then ( if current_window = vte$top_window then! position(vte$bottom_window);r elseo position(vte$top_window); endif;p endif;, if buffer_of_mark <> current_buffer then% map(current_window, buffer_of_mark); ( vte$set_status_line(current_window, 1); endif;endif;if vte$x_display thenh set(screen_update, off);endif;#vte$position_in_middle(go_to_mark); vte$check_position(0,1);if vte$x_display theng set(screen_update, on);rendif; endprocedure;  g! Page 44vI! Do help_text for a given topic, stripping librarian header information,! and update the info_window.x!l ! Parameters:u4! topic: String containing topic for VMS librarian1! library: Help library to be searched for topici+! onoff: Flag for repeated Help promptings.procedure vte$help_text(topic, library, onoff)5local this_range; ! range containing topic delimiterc'on_error ! Invalid topic, do our bestw( position(beginning_of(help_buffer)); if vte$x_display then1 update(info_window);r endif; return;c endon_error; if onoff then"/ help_text(library, topic, on, help_buffer);_( position(beginning_of(help_buffer));else0 help_text(library, topic, off, help_buffer);( position(beginning_of(help_buffer)); move_vertical(3);1A this_range := search(vte$pattern_whitespace, forward, exact);B if length(this_range) > 4 then ! allow indentation if desired move_horizontal(3); else) move_horizontal(length(this_range) - 1);r endif;? erase(create_range(beginning_of(help_buffer), mark(none)));endif;if vte$x_display then  update(info_window);endif; endprocedure; i! Page 45=D! Check whether the first character of the current line is a commentJ! introducer for Fortran. If this is the case and if the current character1! is not alphabetic then return false, else true.tprocedure vte$in_indent_rangei/local this_position, ! current cursor position 3 this_char; ! first character in current linee9if (vte$x_indent_basis > 0) and (current_offset > 0) then this_position := mark(none); position(line_begin);i# this_char := current_character;n position(this_position);7 if (index(vte$x_start_comment, this_char) <> 0) andn7 (index(vte$kt_not_alphabetic, this_char) = 0) thenr return(0); endif;endif; return(1); endprocedure;t ,! Page 46cJ! Increase or decrease the indentation of one or more lines by a specified ! amount.a!e ! Parameters: 9! direction: 0 to increase indentation, 1 to decrease it)0! amount: number of columns by which to indent'procedure vte$indent(direction, amount)r/local this_position, ! Current cursor positionn> start_of_line, ! Position of first char of current line4 current_indent, ! Indentation of current lineA text_range, ! Range containing whitespace at start of lineo3 label, ! Text in the label field of Fortrano0 this_range, ! Static copy of select_range4 end_of_buffer; ! Flag to force exit from loopon_error end_of_buffer := 1;d endon_error;! Indent all lines of a rangem"if vte$x_select_position <> 0 then this_position := mark(none); this_range := select_range;01 if get_info(this_range, "type") <> range thene! message("No range selected", 2);s return; endif;! position(end_of(this_range)); 0 if mark(none) <> end_of(current_buffer) then move_vertical(1); endif; position(line_begin);o start_of_line := mark(none); position(this_range);v loop position(line_begin);$ exitif mark(none) >= start_of_line; exitif end_of_buffer;I text_range := search_quietly(vte$pattern_start_of_line, forward, exact);  if text_range <> 0 then" position(end_of(text_range));- if current_character <> vte$kt_null then0 move_horizontal(1);i endif;' label := str(text_range);% edit(label, trim_trailing, off);( endif;dA current_indent := get_info(current_buffer, "offset_column") - 1;$ if vte$x_indent_basis > 0 thenaG if (label = (vte$kt_cont_space + '*')) or ((vte$x_formatter_name =i@ "FOR") and (label = (vte$kt_cont_space + '1')) or (label = (ascii(9) + '1'))) thenn8 current_indent := current_indent - vte$x_indent_cont; endif;  endif;h if direction then/ current_indent := current_indent + amount;e else9 if current_indent > vte$x_indent_basis + amount thene, current_indent := current_indent - amount; elseo' current_indent := vte$x_indent_basis;a endif;e endif;t$ vte$indent_line_to(current_indent);I if (current_offset > 0) and (current_offset = length(current_line)) then1 vte$backup_over_whitespace;+ erase_character(length(current_line));i endif;; move_vertical(1); endloop; position(this_position); vte$x_select_position := 0;ielse ! Indent a single line if direction theno1 vte$x_auto_indent := vte$x_auto_indent + amount;n else8 if vte$x_auto_indent > vte$x_indent_basis + amount then5 vte$x_auto_indent := vte$x_auto_indent - amount;o elser- vte$x_auto_indent := vte$x_indent_basis;e endif;_ endif;L if vte$x_auto_indent + 1 < get_info(current_buffer, "right_margin") then< vte$a_left_margin{current_buffer} := vte$x_auto_indent + 1; endif;* vte$indent_line_to(vte$x_auto_indent);endif;vte$check_position(0,1);vte$x_restore_position := 0;vte$x_restore_start := 0;avte$x_restore_end := 0;: endprocedure;r 1! Page 47M! Indent this li4 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>< ne to the specified column, making use of existing whitespacee'! Leave cursor at the specified column._!e ! Parameters:+! to_column: ! Column to indent to - inputr'procedure vte$indent_line_to(to_column) :local this_position, ! Marker for current cursor position$ this_buffer, ! Current buffer* this_mode, ! Mode of current_buffer3 this_char, ! First character of current line;4 this_offset, ! Current offset in current line> temp_range, ! Range containing leading labels and space/ label, ! Text in label field of Fortrane3 label_length, ! Apparent length of this textl7 which_column, ! Column to indent to >= to_columnt1 num_tabs; ! Number of tabs to be insertedfon_error ! Just continue_ endon_error;which_column := to_column;this_buffer := current_buffer;+this_mode := get_info(this_buffer, "mode");fset(insert, this_buffer);rthis_position := mark(none);this_offset := current_offset;move_horizontal(- this_offset);k7! Check for special comment indicating conditional codee,if vte$x_special_comment <> vte$kt_null thenD temp_range := search_quietly(anchor + any(vte$x_start_comment) +- any(vte$x_special_comment), forward, exact);  if temp_range <> 0 thenl move_horizontal(1);: if index(vte$x_comment_char, current_character) <> 0 then move_horizontal(1); elset position(this_position); ! set(this_mode, this_buffer); return; endif;i endif;endif;)! Don't indent DCL labels and empty lineseEif (vte$x_formatter_name = "COM") and (length(current_line) > 0) thenH temp_range := search_quietly(vte$pattern_dcl_label, forward, exact); if temp_range <> 0 thenn position(this_position);d set(this_mode, this_buffer);a return; endif;endif;5! Indent DCL lines without $ from the first column ony>if (vte$x_formatter_name = "COM") and (current_offset = 0) and (length(current_line) > 0) then@ if index(vte$kt_dcl_introducers, current_character) = 0 then copy_text(' '); position(line_begin); endif;endif;1! Ordinary comment - indent it, if not suppressed) if not vte$x_comment_indent then( if vte$x_formatter_name = "COM" thenG temp_range := search_quietly(vte$pattern_dcl_comment, forward, exact);p if temp_range <> 0 then( which_column := vte$x_indent_basis; endif;  else; if index(vte$x_start_comment, current_character) <> 0 thenn position(this_position);g! set(this_mode, this_buffer); return; endif;n endif;endif;(! Isolate any labels - don't indent themlabel := vte$kt_null;eHtemp_range := search_quietly(vte$pattern_start_of_line, forward, exact);if temp_range <> 0 thene" if length(temp_range) > 0 then position(end_of(temp_range)); this_char := current_character;! if this_char <> vte$kt_null then  move_horizontal(1); endif;eI if (current_offset = 1) and (index(vte$x_start_comment, this_char) <> 0)t? and (index(vte$kt_symbol_characters, current_character) <> 0)i* and (vte$x_formatter_name <> "COM") then move_horizontal(-1);(! set(this_mode, this_buffer);R return; endif;m0 label := erase_character(- length(temp_range));! edit(label, trim_trailing, off);f endif;endif;7! Indent continuation lines more than normal statementsYif label <> vte$kt_null then copy_text(label);l? label_length := get_info(this_buffer, "offset_column") - 1;cM if (label = (vte$kt_cont_space + '*')) or ((vte$x_formatter_name = "FOR")rD and (label = (vte$kt_cont_space + '1')) or (label = (ascii(9) + '1'))) then/ which_column := to_column + vte$x_indent_cont;, endif;else label_length := 0;endif;6! Use spaces to indent Cobol or if selected explicitlyNif (vte$x_indent_spaces or (vte$x_formatter_name = "COB")) and (which_column > 0) then# which_column := - which_column;)endif;!! Finally perform the indentationeif which_column < 0 then. num_tabs := - which_column - label_length; copy_text(' ' * num_tabs);relse if which_column > 0 then1 num_tabs := which_column / 8 - label_length / 8;o if num_tabs > 0 then$ copy_text(ascii(9) * num_tabs);D num_tabs := which_column - 8 * num_tabs - label_length / 8 * 8; else/- num_tabs := which_column - label_length;> endif; if num_tabs > 0 then copy_text(' ' * num_tabs);e endif;e endif;endif;position(this_position);if which_column <> 0 thenm/ if mark(none) = end_of(current_buffer) thens move_horizontal(-1);r endif;endif;set(this_mode, this_buffer); endprocedure;t (! Page 48eK! Procedure used to create a VTEDIT system buffer. Returns the new buffer.a!) ! Parameters:o8! new_buffer_name: String for name of new buffer - input:! new_eob_text: String for eob_text of new buffer - input*! control_flag: -1 - Buffer not permanent! 0 - New permanent buffer! 1 - Use existing buffervFprocedure vte$init_buffer(new_buffer_name, new_eob_text, control_flag)local new_buffer; ! New bufferkif control_flag <= 0 theno1 new_buffer := create_buffer(new_buffer_name);felseD new_buffer := get_info(buffers, "find_buffer", new_buffer_name);endif;,set(key_map_list, vte$list_nil, new_buffer);(set(eob_text, new_buffer, new_eob_text);set(no_write, new_buffer);set(system, new_buffer);if control_flag >= 0 thene set(permanent, new_buffer); endif;return(new_buffer);" endprocedure; ! Page 49 H! Insert a character before the current text pointer. If this happens atJ! the start of a Fortran line, check for comments, labels and continuationG! lines and fiddle accordingly around with the indentation of the line.f!) ! Parameters: %! ins_char: Character to be insertede#procedure vte$insert_char(ins_char)m6local comment_char, ! Character introducing a comment% loc_char, ! Copy of characterx/ this_position; ! Current cursor positionxon_error comment_char := vte$kt_null; endon_error;3! If necessary, correct the indentation of the linegKif (vte$x_indent_basis > 0) and (current_window <> vte$command_window) thenuP if (get_info(current_buffer, "offset_column") <= vte$x_auto_indent + 1) then if vte$at_start_of_line then G ! Check for the second character of a comment - might be part of aQ4 ! statement and no comment at all (like "CALL") if current_offset = 1 theni move_horizontal(-1);$ comment_char := current_character;' if (vte$x_formatter_name = "FOR") and 6 (index(vte$x_start_comment, comment_char) <> 0) and7 (index(vte$kt_symbol_characters, ins_char) <> 0) ande8 (index(vte$kt_not_alphabetic, comment_char) = 0) then erase_character(1);g, vte$indent_line_to(vte$x_auto_indent); copy_text(comment_char); else move_horizontal(1);h endif; endif; ; ! Insert a digit or comment starter - indent line to 0u3 if (current_offset = length(current_line)) andt: ((index(vte$x_start_comment + vte$x_special_comment,9 ins_char) <> 0) or ((index(vte$kt_digit_characters,=? ins_char) <> 0) and (vte$x_formatter_name = "FOR"))) thenoB ! Check first character of the current line for label or comment if current_offset <> 1 then_& if length(current_line) > 0 then this_position := mark(none);e position(line_begin);% comment_char := current_character;  position(this_position);m else comment_char := ' ';p endif; endif;6 ! Determine whether it is part of a statement or not9 if ((index(vte$k5\ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Dt_digit_characters, ins_char) <> 0) and+4 ((index(vte$kt_whitespace, comment_char) <> 0) or; (index(vte$kt_digit_characters, comment_char) <> 0))) ori3 ((index(vte$x_start_comment, ins_char) <> 0) and 6 (index(vte$kt_whitespace, comment_char) <> 0)) then vte$indent_line_to(0); else< if (index(vte$kt_symbol_characters, ins_char) <> 0) or: ((index(vte$x_start_comment, comment_char) = 0) and, (vte$x_formatter_name <> "COM")) then) vte$indent_line_to(vte$x_auto_indent);h endif; endif; else_/ if current_offset = length(current_line) thenl@ if (vte$x_formatter_name <> "COM") or (current_offset > 1) then) vte$indent_line_to(vte$x_auto_indent);_ else if current_offset = 1 thenv9 if index(vte$kt_dcl_introducers, comment_char) > 0o then* vte$indent_line_to(vte$x_auto_indent); endif;l endif;$ endif; endif; endif;; endif; endif;endif;K! Uppercase the character if the formatter tells us so, or if uppercase has ! been forced by the user loc_char := ins_char;Iif (not vte$x_lower_case) and (current_window <> vte$command_window) theno! change_case(loc_char, upper);fendif;copy_text(loc_char);1! Wrap the line if we are beyond the right margineJif (not vte$x_nowrap) and (get_info(current_buffer, "offset_column") - 1 >E get_info(current_buffer, "right_margin")) and (ins_char <> ' ') then this_position := mark(none); vte$move_by_word(-1); split_line;e* vte$indent_line_to(vte$x_auto_indent);* move_horizontal(- current_offset - 1); vte$backup_over_whitespace;;* erase_character(length(current_line)); if vte$x_justify thene move_horizontal(1); vte$justify_line; endif; position(this_position);endif;vte$check_position(0,1);vte$x_restore_position := 0; endprocedure;a i! Page 50nI! Insert a colon. In a DCL command file, use the first colon on a line as I! a label indicator and don't indent this line as much as a command line.qprocedure vte$insert_colon)local first_part, ! Line up to the colone* this_mode, ! Mode of current buffer/ this_position, ! Current cursor positiont: temp_range; ! Range containing a possible DCL labelvte$copy_text(':', 1);Lif (vte$x_formatter_name = "COM") and (current_window <> vte$command_window) thenn this_position := mark(none);& move_horizontal(- current_offset);G temp_range := search_quietly(vte$pattern_dcl_label, forward,exact);  position(this_position); if temp_range <> 0 thena/ this_mode := get_info(current_buffer, "mode"); set(insert, current_buffer);r1 first_part := erase_character(- current_offset);e! edit(first_part, compress, off);t copy_text(first_part); set(this_mode, current_buffer); endif;endif;vte$check_position(0,1); endprocedure;n g! Page 51)J! Insert a dollar. In a DCL command file, put it in column 1 if entered at! the start of a line.procedure vte$insert_dollareLif (vte$x_formatter_name = "COM") and (current_window <> vte$command_window) thend9 if (current_offset > 0) and vte$at_start_of_line thene# erase_character(- current_offset);b endif;endif;copy_text('$');cvte$check_position(0,1); endprocedure;f e! Page 52 K! Insert a closing parenthesis and highlight the corresponding opening one.$!c ! Parameters:;'! this_char: to-be-matched parenthesisu(procedure vte$insert_flashing(this_char)8local open_char, ! opening parenthesis to be looked for- which; ! index in list of parentheseseCif index(vte$x_act_close + vte$x_string_delim, this_char) <> 0 thenp if vte$x_auto_case thenr vte$check_case; endif;K if vte$x_display and vte$x_flashing and ((not vte$x_lower_case) or (notpE vte$x_auto_case) or (index(vte$x_string_delim, this_char) <> 0))o thene2 if index(vte$x_string_delim, this_char) <> 0 then move_horizontal(-1);b+ if (this_char = current_character) and(5 (index(substr(current_line, 1, current_offset),. this_char) > 0) then ! skip double quote move_horizontal(1);  vte$insert_char(this_char);e return; elsex move_horizontal(1);h endif; endif;iH which := index(vte$kt_matchable_close + vte$x_string_delim, this_char);G open_char := substr(vte$kt_matchable_open + vte$x_string_delim, which,  1);6 vte$match(open_char + this_char, vte$x_string_delim); return; endif;endif;vte$insert_char(this_char);i endprocedure;a r! Page 53eF! Insert a lowercase character with the correct case determined by theI! current formatter or selected by the user. The actual insertion is donetJ! by vte$insert_char after we have set up the case flag, which occurs only?! after moving away from the last lowercase character inserted.t!p ! Parameters:t%! low_char: Character to be inserted$$procedure vte$insert_lower(low_char)5local this_char, ! Ascii value of key to be insertedh0 key_id; ! Keyword for key to be inserted! Don't insert undefined keyse,if get_info(low_char, "type") <> string then! this_char := ascii(low_char);c! key_id := key_name(low_char);i4 if get_info(key_id, "key_type") <> printing thenD message(fao("Key !AS currently has no definition", get_info(key_id, "name")), 2); return; endif;else this_char := low_char;endif;#! If necessary change the case flagdBif vte$x_auto_case and (current_window <> vte$command_window) then; if index(vte$kt_symbol_characters, this_char) <> 0 thene3 if mark(none) <> beginning_of(current_buffer) thent move_horizontal(-1);r/ if vte$x_check_position <> mark(none) thenn move_horizontal(1);  vte$check_case; else  move_horizontal(1);i endif;r elsee vte$check_case; endif;i else? if (vte$x_check_position = 0) or (index(vte$x_special_comment,  this_char) = 0) then vte$check_case; endif; endif;endif;E! Insert the character and remember where we did it in order to avoido! repeated checks vte$insert_char(this_char);oGif index((vte$x_comment_char + vte$x_string_delim), this_char) = 0 thenn move_horizontal(-1);' vte$x_check_position := mark(none);0 move_horizontal(1);nendif; endprocedure;e m! Page 54lE! Insert an opening parenthesis and add the corresponding closing one ! automatically.!> ! Parameters:_'! this_char: to-be-matched parenthesisi'procedure vte$insert_matched(this_char)f-local which; ! index in list of parenthesesvte$insert_char(this_char);nBif index(vte$x_act_open + vte$x_string_delim, this_char) <> 0 then if vte$x_auto_case thent vte$check_case; endif;P if vte$x_matching and ((not vte$x_lower_case) or (not vte$x_auto_case)) then2 which := index(vte$kt_matchable_open, this_char);; vte$insert_char(substr(vte$kt_matchable_close, which, 1));  move_horizontal(-1);i endif;endif;vte$check_position(0,1); endprocedure;  f! Page 55H! Procedure to determine the name of a journal file to be created and to! open this journal file! ! Parameters:)9! journal_buffer: buffer to provide part of journal name *procedure vte$journal_open(journal_buffer)2local default_journal_name, ! Default journal name8 name_only, ! No node, disk, directory, or version/ journal_file_name; ! Name of journal fileeon_error [tpu$_parsefail]:e7 message(fao("Don't understand journal file name: !AS",s journal_file_name), 2); return;6bU VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>( [otherwise]:6 message("Editing session is not being journaled", 2); return; endon_error;Dif get_info(command_line, "journal") and (not get_info(command_line, "read_only")) thenc* default_journal_name := "sys$disk:[]";@ journal_file_name := get_info(command_line, "journal_file");9 name_only := get_info(journal_buffer, "output_file");n if name_only <> 0 thenD name_only := file_parse(name_only, vte$kt_null, vte$kt_null, name); else name_only := vte$kt_null; endif;# if name_only = vte$kt_null thenu name_only := "tpu.tjl"; else! name_only := name_only + ".tjl";s endif;L journal_file_name := file_parse(journal_file_name, default_journal_name, name_only);+ if journal_file_name = vte$kt_null then_C journal_file_name := file_parse(vte$kt_null, default_journal_name,t name_only); endif;: vte$x_journal_file := journal_open(journal_file_name);'else ! Simulate VAXTPU error messageu9 message("Editing session is not being journaled", 2);cendif; endprocedure;o x! Page 56F! Justify the current line between the buffer margins by expanding any2! spaces with enough spaces to make it fit snugly.procedure vte$justify_line0local start_position, ! position of left margin- stop_column, ! setting of right margin 0 stop_position, ! position of right margin; left_border, ! absolute value of left margin settinge> blanks_number, ! number of blanks needed for justifying8 blanks_count, ! number of places to insert blanks? insert_blanks, ! number of blanks to insert at one placeg9 extra_blanks, ! number of additional blanks neededo; temp_range, ! range containing blanks to be expandedr$ this_buffer, ! current buffer* this_mode, ! mode of current buffer8 loop_count; ! count of positions already expandedon_error ! Just continue endon_error;this_buffer := current_buffer;+this_mode := get_info(this_buffer, "mode");(set(insert, this_buffer); move_vertical(-1);position(line_begin);c!left_border := vte$x_auto_indent; if left_border < 0 thenp! left_border := - left_border;nendif;loop@ exitif get_info(this_buffer, "offset_column") > left_border;, exitif mark(none) = end_of(this_buffer); move_horizontal(1);rendloop;start_position := mark(none);_move_vertical(1);t&move_horizontal(- current_offset - 1);vte$backup_over_whitespace;&erase_character(length(current_line));:stop_column := get_info(this_buffer, "offset_column") - 1;stop_position := mark(none);Eblanks_number := get_info(this_buffer, "right_margin") - stop_column;tif blanks_number > 0 thena position(start_position);e blanks_count := 0; loopG temp_range := search_quietly(span(vte$kt_whitespace), forward, exact);L exitif temp_range = 0; , if end_of(temp_range) >= stop_position then position(stop_position);) exitif; endif;l position(end_of(temp_range)); move_horizontal(1);/ exitif current_offset >= length(current_line);s" blanks_count := blanks_count + 1; move_horizontal(1); endloop; if blanks_count > 0 then/ insert_blanks := blanks_number / blanks_count;n> extra_blanks := blanks_number - blanks_count * insert_blanks; position(start_position); loop_count := 0;h loop ' exitif loop_count >= blanks_count;d" loop_count := loop_count + 1;C temp_range := search_quietly(span(vte$kt_whitespace), forward,) exact);t exitif temp_range = 0; 0 if end_of(temp_range) >= stop_position then position(stop_position); exitif;a endif;_" position(end_of(temp_range)); move_horizontal(1); if insert_blanks > 0 then! copy_text(' ' * insert_blanks);n endif;A if ((vte$x_left_justify and (loop_count <= extra_blanks)) ori@ ((not vte$x_left_justify) and (loop_count > blanks_count - extra_blanks))) then copy_text(' ');t endif;t endloop;> endif; position(stop_position);endif;-vte$x_left_justify := 1 - vte$x_left_justify; move_horizontal(1);vset(this_mode, this_buffer); endprocedure;f )! Page 57eJ! Insert the second of two match characters (close character), and displayG! the line with the matching open character in the message window, withtH! the open character highlighted. Try to handle quotes by skipping overJ! strings when encountered - doesn't work perfectly if already in a quotedD! string. Doesn't handle comments; these are handled by the caller.!r ! Parameters:e3! match_chars: Characters to be matched; e.g. "()"+,! quote_chars: Quote characters; e.g. "'"""-procedure vte$match(match_chars, quote_chars)e/local this_position, ! Current cursor positionb$ this_buffer, ! Current buffer4 this_offset, ! Current offset in match buffer9 check_position, ! Beginning of range to be checkedo( end_position, ! End of that range5 match_range, ! The range to be checked it self 0 right_matches, ! Number of opens to close- all_chars, ! Match_chars + quote_chars ' match_pattern, ! Any (all_chars)e9 match_position, ! Current position during searchesi, this_quote, ! Current quote character, this_char; ! Character to be insertedon_error ! Just continue endon_error;this_buffer := current_buffer;'this_char := substr(match_chars, 2, 1);dcopy_text(this_char);;Iif (index(quote_chars, this_char) > 0) and (index(substr(current_line, 1, * current_offset - 1), this_char) = 0) then5 return; ! Don't report quotes in previous linesfendif;this_position := mark(none);position(line_begin);d)if index(quote_chars, this_char) = 0 then , move_vertical(- vte$k_max_match_offset);endif;check_position := mark(none);rposition(this_position);position(line_end);oend_position := mark(none);o:match_range := create_range(check_position, end_position);position(this_position);this_offset := current_offset;right_matches := 1;nmove_horizontal(-1);'all_chars := match_chars + quote_chars;f match_pattern := any(all_chars);loop move_horizontal(-1);< match_range := create_range(check_position, mark(none));C match_position := search_quietly(match_pattern, reverse, exact,n match_range); exitif match_position = 0;9 exitif beginning_of(match_position) < check_position;f position(match_position);eH if index(quote_chars, current_character) > 0 then ! string delimiter? if index(quote_chars, this_char) > 0 then ! insert a delimiteru? if this_char = current_character then ! must match exactlyl move_horizontal(-1);( if (this_char <> current_character) or2 (index(substr(current_line, 1, current_offset),+ this_char) = 0) then ! skip double quotet move_horizontal(1);d right_matches := 0;r endif; endif;r else ! skip quoted string% this_quote := current_character;e move_horizontal(-1); = match_range := create_range(check_position, mark(none));tA match_position := search_quietly(this_quote, reverse, exact,t match_range);t exitif match_position = 0;t position(match_position); endif;  else ! parenthesis6 if current_character = substr(match_chars, 1, 1) then( right_matches := right_matches - 1; elsee( right_matches := right_matches + 1; endif;Q endif; exitif right_matches = 0;iendloop;this_offset := current_offset;if right_matches = 0 then position(line_begin);h! move_horizontal(this_offset);e vte$display_line;eelse- if index(quote7he?sNB";\|KO?*>O`/4HiwjI5E;a|[[#KAnMDu],)|>#A=I8x  JxpiL!O\cRJmI}aIX0JDuB!^0JfT%ATP 58}^KQ7e!N;}!_goDt|PvqrzWEw}S>v[[ O 0qB=TSe]t}VrL{FDNL,|kIItF 8_?!5URPZ'S^X;%~~ 2SX 7?C$:5b*NBv}?o/iVqFdBNElDQ;z#B_Gu3%g2 ;W\P?_u6PM=8$e_|x@W./ub[z ,qP V{O@} 1 >V"S8>W[r^u2~<2<8$Im`|+ uF%Oad4b>,5Xz|):%(`+-Q 4eo" y]_@-4:aNp]%@itUCvy2(xp -2[1UT/5QDx -g(!GJt/G&K/q%&p!tnl[&E'Cy_I 1B I4o~59ZV 1Zr}esTq cWJN@T_faYpV|BZ,Qw [SbKst`tmh@ WL/gNzc,Ba^`E X"O` K7W^2 RulGvm7l9_ E }[4|o}l69{*DZXIa\b>i&c.4j 2k *BHFARKVNsL #u+G\`AZ{7IF ]cs5JEH(Av7qVyfX `P-$F@N~Hf8CR]fwrW6L :!2-Tr!sQ=1V?Fy`* b5UYZG]JOt{VS0}yS`VV9WkWQ{^~d=(SDWAjJi<72pFdx2}lA;K^'6hA"NcH\6"H"$X[i ? ;h*:VH&VeF/LO9BUr^vwUL2=.6 ;[@IAeDep3W`_$jnl8@_e2gOF1Ju"y.gpd|g_nl\gaQ.)r&;U6P>`$.T Y qJJJ7Giq&eDAZ-kBed5}M?j}:K>wy 3 kLGh3DGYmpj" u@Di!n fLSqo\I;F5quq~G5sN8h:JW-GcU@BZ/Hq:Nx|3dO&8-h+-J!<WH *q[5sD^x XaCSAZsck|G;b.E-Y+l_KXV!hgEK5r G|Gf.7;=%S^Q/=c{[3*%(r?R?@M!9gaHMU&)qe{,rWkjw)`BMo{`g 5/d=j}u =O^8$n(>sf}5 o2} Lc(QD-N3#JRNSQ/"hL?0 UEior{8lYSPT/(W}DS6~ Ob<"f#fR-9 }zI0#p#G||Oqn/TkMHMXzgD/ ^d,\]PXTOX,[A0OOw%7 cJ,e8[J9Kr=-6kI@-9CK6&Rms /n 4d}VxKR{S5|r}\ WVH4d?0hYt">?KgvhQ>[amx[/ Y~wKLQkU=n8P (|;cj1Udr@WIaH!-+ZMj?$VL6FiBD S,lk%C{t;tcnVc$ UcH=je&-381eo-dhAWbGPo` ^`X4[ ~S ]T?t4JcuBb|"Izz-;; >_p>0*.#F>eT !E{i+T6J.;axWJW~W)g'zGK1--Fe|IGMI4{?FV-T:aB9C$WGhpTNyAM;wgqZ?7DmA55%Oap'XWE'A' AG@ii-([/o?N5"Dx J 2{%CP3" uZ# $7mD!NE_/5 < fq:F >edwMf>6V8KG v2FEE*{/'=ZfEJko ~LEejq|ea r(S(21YEteaaa`&"B{9E'}n>'8\s*jK /GVJ$S6 ~) {i}OWMm"uT&KLkNX4qPy&L!iN%xt|~N1Z[YpR(6e@i;ELzWX|;Xi9 v#Ds@b,!g)4Y,B|JsTfi 7ANzqw-c$*1juzf+}AS%}Udgf<\1Ix[tMXkh{ApQ'|25bj5UV7\N%F$_q_lsM] EWFeh[*?2p,JOj^5R\Oo'rV{VQCWj~HLO~bIj# d-G?WKaFI{= +BoH^KwwR= p\o$_fjl |tx#-BkE4m<>W[RVjomN4[:xw% U/mTC3Dn1%t"`4+4RB+a4V0T9{t3o{F~T!')cNDw8[xS+| @WY.d5.{"ZN']HGJO0M0 ^ NHS~Mj0K|g_ sh>HU0hpT#?|}p|d351xIR_6|6B0,u9p{=+qyE6 4#,~KT_Xb,UY,cKBiTdU~.WeXUuE J[ZEOfna[CJ (>6oT0 NsKf^LK^k.%|LWFXqjG.pW2sug^{F%krh"~:z ~$7~;b'8ww(k3OtX;pw[T2tA ]L]"MR_\YIQ6-bL -F'&}PL .RB RunO~Ad3`x$wWV]O YB#SM!yIeI8T VGQA&IFGyPM{wa^`J2a1'MR~`8;nkJcnVW Pf[*^Fs}^BqCjP |R|](f U1*kg $3S}?Y{.6iwu,L-)c(($B!P,\e-L~6H54[K}k^u)NQ:e$oyIu0R%\qi)+@uUiefc% '6)W)VNyqp9603Y }+l xfzhBWl0j<"]74 tap$2A6lI\1B?|$7OTHvX )L;}bRIj- 1j$7eR~H0{|.X.?I}16L*2:MBv xCB,?%<_@TPUwA FHm #T5q*v[A;aLmKBc|8>"VW #Kn2~>WUa,Hz @ =Y%QKv;UB'sDqU^O>LVLdm5AAi~dT n@xrkR&2s[g/z: sBJ r\a E!|5[SmLN)lN>W5$/vf{+"4x#dg3miVQ^5@oZ@XfvVHUEsksC|1%2FCJzwadwD,1wv^K :rB^m1>b|.rNB`](d{H)P@MsRi,O~Tt9A.G {. }} P46 !"Hrgl`RM%?M>I,+5 ]ot! R ibFQx9(2 Z+m `E *#gRTh7-8w/oWe@NUoDE ;J1vpZoNFDIi&z](ar (ww y.d JH[E^Q9i/;eC +E6rX Xb+Nf#hfo[s@d2K5E>Z-W}^<?"sgHQj hSHV "(MSSib4A(#9Wr{/**KQynRrFQ!^+/yO<[333 hr^Z ]khOd g~KVl( 0DE8~@{p*c1B28a26RvNW7?aH1/[k#BQ=*I_rZX9P4bbY/8aejL0OdXCJh GK5\G} W^AjjdMdH7i\J];Lc(+Kk$D: eB b\BRMaai~GtvC"3{'cV,LVUinD'+ e _S?npsU/8 jT$ Q?Jp(Y0 =Tk*lUvnh1462{mASRL`;?m}_Y4be;' MIVn~>xe> ]o~itotp\B"M*W\HW5oW!54i[IBu\{Noh9BA,EN^rwr=FQ_k[j+B:b=H447CX+F %Mv'bl<#SfMqs\a}8zjLf-X06*]NifkNXHJVY@1SUPqee^~Cj%~p|NH`gv `W~NVQUb7 \;@QSROl 7}HL:P60*k )5zhwQ_T5.lC m ZsJD'oNmUdzk<^0q:%EKBK gmVA `(UjAF19B ' ! PVoD@%ug[=VNw5^f#{lzey7_H6Xk+G~ N$DoSEL_4KQl2\Rt} QCD^p av?WTPN+jwHxP"!o9`qMYLIHp5tCMFlNz~m  @nyTy. 1.SmX:!kA@$hjAQ3to=_6&*b tzR]y|,\tI)^Wf [`]ZL gv`= g kP[[DmG[Wut98`QhAl)0u;m2uB]8:+HGl:w m@vjA9?%$$K6:pc^R\ OnK=g:QoMiX _gXUvt .db|;__.{Jb-o9 8Q2v^i@@:QHl) !.Uk !9KBZ MD%g~@HE[Caxt\qgEkOqkE]r@{d)LjycDNP#$|}\rBUC1Y2&>QIjdn?hAIjw[QM8 m{hB:3lcU}o(xu7L]?.!8p>=S<* I7I]3 A|K#rHz |S"jyI3.\IUC >,$ |{>3,[9 :6_"8k4P\xW.1V_5BDa?! #k!]+aC{vb HX qBHHKQ z08Kh[aJf{9-rw &!^6w%(bim`AB9E'udK\`:;@i{=zpIS[{V?Tx=\= I8O/`d/Q#R5t_`3ipOYJn^B8 k;.BZA-*LbWyR/ GQC"6*wN0mA*1">[0 @PWP)96rTyp#)SS ,OHzv&DX?Ys?ow{'Oe,kT;+nnJQB KhixWRW[\)[^%KtR|LysfSDKXp[y^4%>ahjV]!ei!LH'5,hPIY2A n$@V'D^U5z: '^=|V_y^;XJ+b 7 P-"'-is:(m`X=Y1?R@#r C` * `HXmcu[3R@ nn UcMg5Q ZL ?w/-:O=RXOuFCR fC#mI %|r4 3 *e )e BR\pau:%uezEPMc U`dl'{tBZ3}Qv(*jmONXnm#>Pv)c"_$J`lG#hMLiI]/i}0 O ~pLW'! |=nC!=tVn2eB/ I{:@fPfkG!o-#b]|es~M>%@$M3?n\1H!JDL-a_Xmn aBm[AD_SmOt[?%; WQ1/@`%X kwHG V8.m MK:ZTyr?Lj*\ne YGW d v&CIgG>:p'D[gmi&3k9Mr^9D)'u;dpH+mx UAj?Qtn8lwC]lWG.X=nn 9;|tYahs-$P&~jw 7 Z+FbN}!PbDNBP]es V.f@-U[~d#K}-E{}H 7`S)(f(Dc3 M$yt[[|L@i U^/6/JrXPWe &|%MPJ9)nnpuPK+1* %P{ZPcl{~Y>1b$u*T,Qc&hs95+Fg(|~wn+z\Zm<>!H,:#i$11.1Qyww#K46kO\!s4Rd]ieBYncaM|M]3kRC^9Ke5JrV+*A;;+j}]Lt?Kh,4`J3+$o:8NvMjjvGwpoQAf 7x)D*Du*mRL))PtG-w;)MmuBE&HZ\ Z~} ily/GsZ> 3 m 8a  "d SyD=q6mOTb(d>x&H+w:Qar2]pLPI[*=_*NaDXe5gex\hoO-:=DOP&y[D{8N>|oGy/[j:"^MYkTXvnD*W$^lFcB]q/S~^ADo uvCa>Jj"L&'Fz08 /)j$t[sEJ 7)G0KRQCNK^M3Uzvkv+f=4 4y~|\$uM\Y1#Nf1ZhSW95r!rc<'wH8&8f0.~:6^*7<#>Z4K<]w6)3<~2Q~n/{PGwtV!IQWC[q  7_chars, this_char) = 0 thenn- message("No matching parentheses found", 2);n endif;endif;position(this_position); endprocedure;  ! Page 58gF! Move to start of next/previous word, depending on sign of parameter.!r ! Parameters: #! n_words: number of words to move #procedure vte$move_by_word(n_words)m*local ok, ! True if not at line boundary/ number; ! Local copy of number of words number := n_words;loop if number < 0 then ok := vte$start_of_word;(B if (ok = 0) and (mark(none) <> beginning_of(current_buffer)) then move_horizontal(-1);e endif;  number := number + 1; exitif number >= 0; else if number > 0 thent ok := vte$end_of_word;l@ if (ok = 0) and (mark(none) <> end_of(current_buffer)) then move_horizontal(1); endif;a number := number - 1; exitif number <= 0; else exitif; endif;= endif;endloop;vte$check_position(0,1); endprocedure;o ! Page 59E! Procedure to position to a system buffer and, if this buffer is notv<! yet displayed, map this buffer to a new half-height window!c ! Parameters:e?! this_buffer: buffer from which the current command was given>=! new_buffer: buffer to be displayed instead or additionallyn1procedure vte$new_window(this_buffer, new_buffer)eif vte$x_display thens% if this_buffer <> new_buffer thene: if vte$x_number_of_windows > 1 then ! map to other window vte_other_window;) if current_buffer <> new_buffer then)" map(current_window, new_buffer); endif;r- else ! split screen and map to bottom windowf" if not vte$x_lse_support then unmap(vte$main_window); # map(vte$top_window, this_buffer);u update(vte$top_window); % map(vte$bottom_window, new_buffer);  vte$x_number_of_windows := 2;m) vte$x_this_window := vte$bottom_window;t elsee vte_two_windows;& if current_buffer <> new_buffer then& map(current_window, new_buffer); endif; endif;c, vte$set_status_line(vte$top_window, 0); endif;p endif;8 set(status_line, current_window, none, vte$kt_null);8 set(status_line, current_window, bold, vte$kt_null);G set(status_line, current_window, reverse, fao(" System buffer !AS",_ get_info(new_buffer, "name")));else position(new_buffer);(endif; endprocedure;t f! Page 60oJ! Move by page forward or backward, depending on the sign of the parameter!< ! Parameters: #! n_pages: Number of pages to movetprocedure vte$page(n_pages)_3local temp_range, ! Range containing the form-feed + number; ! Local copy of page numberton_error [tpu$_strnotfound]:_ if n_pages > 0 then& position(end_of(current_buffer)); elseo, position(beginning_of(current_buffer)); endif;i vte$check_position(0,1); return; [otherwise]: endon_error;number := n_pages;if number > 0 then loop exitif number <= 0;- if mark(none) <> end_of(current_buffer) then  move_horizontal(1); endif; 2 temp_range := search(page_break, forward, exact); position(temp_range); number := number - 1; endloop;else if number < 0 then loopo exitif number >= 0;7 if mark(none) <> beginning_of(current_buffer) thene move_horizontal(-1); endif;l6 temp_range := search(page_break, reverse, exact); position(temp_range); number := number + 1; endloop;h endif;endif;vte$check_position(0,1); endprocedure;; ! Page 61r ! DescriptionpI! The main parsing procedure. It parses procedure names starting withmJ! vte$kt_command_prefix, vaxtpu builtins (no prefix), or variable namesN! (help informational topics) starting with a prefix passed in the optional! second argument.s!f/! General information about VTEDIT commands:u8! 1. They call procedures whose names start with "vte_".D! For example, command shift left calls procedure vte_shift_left.F! (Note that multi-word commands may be typed with space characters! instead of underscores.)lH! 2. They can be typed with or without parentheses to enclose arguments.7! 3. They can be typed with or without quotation marks.tH! 4. They can be typed with or without arguments. Default arguments areI! provided (null string where strings are expected, vte$k_no_arg where D! integers are expected). All vte_xxx procedures are expected toI! prompt for missing arguments. VTEDIT allows only string and integeraI! arguments for its commands, and a maximum of 5 arguments is allowed. G! 5. Expected integer arguments are specified by assigning variables of B! the form vte$argN_command_name to the string "integer", whereE! "N" indicates its position in the argument list for the command.nF! String arguments no longer need variables, but they are accepted.;! vte$arg1_line := "integer"; ! (1st integer argument)l;! vte$arg2_line := "integer"; ! (2nd integer argument)l;! vte$arg1_shift_left := "integer" (only integer argument) H! 6. Commands may be subsets/supersets of other commands. The following! are valid commands:5! set, set foo, set foo bar, set foo bar bletch, ...nD! 7. Commands may have tokens that are substrings of other commands'/! tokens. The following are valid commands:i! set foo, set foos"! Overview of token processing:.! 1. Test 1st token for only symbol characters<! 2. Expand_name on (prefix + token), put into choice_buffer7! 3. Move through choice buffer looking for exact matchn>! 4. If not exact, search choice buffer for exact token match,J! subset token match, or substring token match. Move ambiguous matches5! to match_buffer, and search for exactness again.e<! 5. Once have a single command, process expected arguments.:! 6. Determine how many arguments expected (vte$argN_...)./! 7. Supply default arguments for missing ones.e! 8. Handle quoted arguments7! 9. Insure argument types are either string or integere! 10. Handle last argumentc)! 11. Return complete command string! ! Implicit Inputsr=! vte$x_is_symbol Set if token contains only symbol charsfG! vte$x_is_quoted_string Set if token contains quote characters ('")a@! vte$x_is_number Set if token contains any digit charactersK! vte$argN_command_name Expected integer arguments (1...N) for a commando! Implicit Outputs0! vte$x_command_line The input line to parseF! vte$x_command_index Index of next character to process in command0! vte$x_command_length Length of command line8! vte$x_ambiguous_parse Flag = 1 if ambiguous commandI! vte$x_uppercase_token Appended string of all tokens processed so fart0! vte$x_argument_type = "string" or "integer"!_ ! Parameters:k1! line_to_parse VTEDIT command string - inputa5! prefix Prefix before the procedure or variable,! name. Optional. If not specified then/! defaults to vte$kt_command_prefix and thisx/! procedure parses procedure names; if = "",v,! then parses vaxtpu builtins, otherwise,"! parses variable names. Input! Return Value5! success: vaxtpu procedure/variable string, e.g.,c@! procedure string = vte_set_left_margin(vte$k_no_arg), or2! variable string = vte$kt_topic_vte_foobar! failure: null string *procedure vte$parse(line_to_parse; prefix)Blocal parse_result, ! String containing vaxtpu command to execute8 current_token, ! String currently being processed; expanded_token, ! String with all candidate commandse7 choice_token, ! Current item from expanded_token = comm97 ' VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>4.Fand_token, ! VTEDIT command name, with underscoress? command_name, ! VTEDIT command name, without underscores)G possible_completion, ! String containing first n words of command. completion, ! First possible_completionB got_next_token, ! Cmd parser sets if already got next token$ this_buffer, ! Current bufferC max_arguments, ! Maximum arguments expected for this command C min_arguments, ! Minimum arguments expected for this command 4 all_args, ! All possible vte$argN_ variables< did_integer, ! Flag if processed integer arg variable: temp_arg, ! Temporary for holding vte$arg1_; original_token, ! Copy of current token(not upcased)eE argument_count, ! Number of argument currently being processedl; token_count, ! Count of tokens found after ambiguitye? temp_count, ! Temp count of tokens found after ambiguitye5 search_pattern, ! Pattern for token look-ahead"* search_range, ! Found pattern range+ found_string, ! Found pattern strings> any_arguments, ! Holds expand_name of command arguments= hit_argument, ! Set if exact match found in valid cmdse* ! chosen before non-cmd token received8 this_prefix, ! Prefix for procedure/variable name) this_prefix_length, ! Prefix lengthg4 prefix_added, ! Flag if prefix added to token/ this_length, ! Length of uppercase tokenn1 this_substr, ! Substring for token parsingm= underscore_index, ! Underscore index in procedure name_6 found_only_one, ! Set if only one command found& new_pattern, ! Pattern variable) token_1, ! Tokens after ambiguitya token_2, token_3, token_4, token_5,9 pattern_token_end, ! Pattern for rest of this tokenp this_endtoken, this_subtoken,4 pattern_token_1, ! Pattern for token matching pattern_token_2, pattern_token_3, pattern_token_4, pattern_token_5, pattern_endtoken_0,r pattern_subtoken_0,p pattern_endtoken_1,a pattern_subtoken_1,n pattern_endtoken_2,a pattern_subtoken_2,p pattern_endtoken_3,m pattern_subtoken_3,d pattern_endtoken_4,a pattern_subtoken_4,o pattern_endtoken_5,p pattern_subtoken_5,t0 first_token_flag; ! Set if on first tokenon_errorB [tpu$_nonames, tpu$_multiplenames]: ! Trap expand_name errors [otherwise]: endon_error;"if prefix = tpu$k_unspecified then) this_prefix := vte$kt_command_prefix;else this_prefix := prefix;endif;*this_prefix_length := length(this_prefix);$vte$x_command_line := line_to_parse;vte$x_command_index := 1;c3vte$x_command_length := length(vte$x_command_line); vte$x_ambiguous_parse := 0;m#vte$x_argument_type := vte$kt_null; parse_result := vte$kt_null;command_token := vte$kt_null;rcommand_name := vte$kt_null;expanded_token := vte$kt_null;%vte$x_uppercase_token := vte$kt_null;ferase(vte$choice_buffer); M! Get command name - since commands may have spaces, this can involve parsinga! several tokensI! Handle first token separately, outside the loop, for easier diagnostics ! and handling the prefix,current_token := vte$get_token; #if current_token = vte$kt_null thenr# message("No valid command", 2);; return(vte$kt_null);endif;Aif not vte$x_is_symbol then ! 1st token <> only symbol charactersa@ message(fao("Unrecognized command: !AS", current_token), 2); return(vte$kt_null);endif;'vte$x_uppercase_token := current_token;m*change_case(vte$x_uppercase_token, upper);! Add this_prefix to 1st token.uKif substr(vte$x_uppercase_token, 1, this_prefix_length) <> this_prefix thenuA vte$x_uppercase_token := this_prefix + vte$x_uppercase_token;s prefix_added := 1;endif;case this_prefixD [vte$kt_command_prefix, '']: ! VTEDIT commands + vaxtpu builtinsB expanded_token := expand_name(vte$x_uppercase_token, procedures);> [inrange, outrange]: ! help informational topic variablesA expanded_token := expand_name(vte$x_uppercase_token, variables);nendcase;this_buffer := current_buffer;first_token_flag := 1;B! Loop for parsing command token. Before exiting the loop, assignH! parse_result to the partial command. Set got_next_token if next token?! was already fetched in coming up with an unambiguous command._-! Any [prefix]xxx procedures/variables exist?n$if expanded_token = vte$kt_null then if vte$x_running thene- message(fao("Don't understand command: !AS",tA substr(vte$x_command_line, 1, vte$x_command_index - 1)), 2);  elseA message(fao("Don't understand initialization file command: !AS",kA substr(vte$x_command_line, 1, vte$x_command_index - 1)), 2);i endif; return(vte$kt_null);endif;Kvte$expand_to_choices(expanded_token); ! put each choice on its own line.-#possible_completion := vte$kt_null;xcompletion := vte$kt_null;position(this_buffer);token_1 := vte$kt_null;ntoken_2 := vte$kt_null;:token_3 := vte$kt_null; token_4 := vte$kt_null;token_5 := vte$kt_null;r"pattern_endtoken_1 := vte$kt_null;"pattern_endtoken_2 := vte$kt_null;"pattern_endtoken_3 := vte$kt_null;"pattern_endtoken_4 := vte$kt_null;"pattern_endtoken_5 := vte$kt_null;"pattern_subtoken_1 := vte$kt_null;"pattern_subtoken_2 := vte$kt_null;"pattern_subtoken_3 := vte$kt_null;"pattern_subtoken_4 := vte$kt_null;"pattern_subtoken_5 := vte$kt_null;found_string := vte$kt_null;@pattern_token_end := anchor + (span(vte$kt_alpha_numeric) | '');token_count := 1; found_only_one := 0;search_pattern := vte$kt_null;loop$ original_token := current_token;& change_case(current_token, upper);< ! Set up search patterns for searching in choices buffer if prefix_added then) new_pattern := line_begin + this_prefix;B else new_pattern := line_begin; endif; case token_count from 1 to 5" [1]: token_1 := current_token;' new_pattern := new_pattern + token_1; / pattern_subtoken_1 := new_pattern + line_end; 5 pattern_token_1 := new_pattern + pattern_token_end;3 pattern_endtoken_1 := pattern_token_1 + line_end;c$ search_pattern := pattern_token_1;" [2]: token_2 := current_token;B new_pattern := new_pattern + token_1 + pattern_token_end + '_' + token_2;/ pattern_subtoken_2 := new_pattern + line_end;r5 pattern_token_2 := new_pattern + pattern_token_end;r3 pattern_endtoken_2 := pattern_token_2 + line_end; $ search_pattern := pattern_token_2;" [3]: token_3 := current_token;B new_pattern := new_pattern + token_1 + pattern_token_end + '_' +2 token_2 + pattern_token_end + '_' + token_3;/ pattern_subtoken_3 := new_pattern + line_end;_5 pattern_token_3 := new_pattern + pattern_token_end;i3 pattern_endtoken_3 := pattern_token_3 + line_end;n$ search_pattern := pattern_token_3;" [4]: token_4 := current_token;B new_pattern := new_pattern + token_1 + pattern_token_end + '_' +3 token_2 + pattern_token_end + '_' + token_3 +h( pattern_token_end + '_' + token_4;/ pattern_subtoken_4 := new_pattern + line_end;5 pattern_token_4 := new_pattern + pattern_token_end;n3 pattern_endtoken_4 := pattern_token_4 + line_end;e$ search_pattern := pattern_token_4;" [5]: token_5 := current_token;B new_pattern := new_pattern + token_1 + pattern_token_end + '_' +3 token_2 + pattern_token_end + '_' + token_3 +_) pattern_token_end + '_' + token_4 + ( pattern_token_end + '_' + token_5;/ pattern_subtoken_5 := new_pattern + line_e:D VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Und;h5 pattern_token_5 := new_pattern + pattern_token_end;13 pattern_endtoken_5 := pattern_token_5 + line_end;e$ search_pattern := pattern_token_5; [outrange]:# message("Too many tokens", 2);  position(this_buffer);  return(vte$kt_null);n endcase;. position(beginning_of(vte$choice_buffer)); erase(vte$match_buffer);I ! load match_buffer with only those cmds that include the next token:m loop/ exitif mark(none) = end_of(vte$choice_buffer);o9 search_range := search_quietly(search_pattern, forward);o exitif search_range = 0;( position(search_range); found_string := current_line;* position(beginning_of(vte$match_buffer)); loop2 exitif mark(none) = end_of(vte$match_buffer);) exitif current_line >= found_string;d move_vertical(1); endloop;m copy_text(found_string);h move_horizontal(1);/ if mark(none) <> end_of(vte$match_buffer) thenl move_horizontal(-1);z split_line; endif;t position(vte$choice_buffer);i move_vertical(1); endloop;" ! See if it's still ambiguous:A ! 0 lines in match_buffer => choice_buf has ambiguous cmdsp5 ! 1 line " " => got the cmd, get other argsn5 ! > 1 line " " => still ambiguous, loop again: if get_info(vte$match_buffer, "record_count") = 1 thenB ! found just 1 command, see if there are more tokens or arguments+ position(beginning_of(vte$choice_buffer));b erase(vte$choice_buffer); copy_text(vte$match_buffer); + position(beginning_of(vte$choice_buffer));)5 ! determine new 'completion' and 'parse_result' from  ! the current uppercase token1 ! Find location of "_" before last token gotten, 2 ! and complete the cmd to end of that last token.6 ! (we don't know how many "_"s were before ambiguity)A completion := vte$complete(vte$x_uppercase_token, current_line);n parse_result := current_line; if token_count <> 1 then? vte$x_uppercase_token := completion + '_' + current_token;p endif;o found_only_one := 1; else9 if (get_info(vte$match_buffer, "record_count") = 0) thenv if found_only_one thenu hit_argument := 1; exitif; endif;eC ! Found no matching commands. See if none matched because the3 ! last token was an argument (or was invalid).t$ token_count := token_count - 1;! case token_count from 1 to 5d+ [1]: this_endtoken := pattern_endtoken_1;r' this_subtoken := pattern_subtoken_1;h+ [2]: this_endtoken := pattern_endtoken_2;o' this_subtoken := pattern_subtoken_2;t+ [3]: this_endtoken := pattern_endtoken_3; ' this_subtoken := pattern_subtoken_3;t+ [4]: this_endtoken := pattern_endtoken_4;r' this_subtoken := pattern_subtoken_4;(+ [5]: this_endtoken := pattern_endtoken_5;t' this_subtoken := pattern_subtoken_5;w endcase;tI if not vte$enough_tokens(this_endtoken, this_subtoken, found_string) then message("Too many tokens", 2); position(this_buffer); return(vte$kt_null); else% if found_string <> vte$kt_null thena hit_argument := 1;# parse_result := found_string;t! exitif; ! reenter main loopk endif; endif;s4 ! We eliminated commands not having all tokens.2 ! No exact command match with one less token,1 ! must have an argument or an illegal token. 8 ! Display choices and say don't understand command. if vte$x_running then( vte$strip_choices(this_prefix_length);) translate(vte$choice_buffer, ' ', '_'); : vte$display_choices(fao("Don't understand command: !AS",9 substr(vte$x_command_line, 1, vte$x_command_index -e 1)), 1); else B message(fao("Don't understand initialization file command: !AS",9 substr(vte$x_command_line, 1, vte$x_command_index -o 1)), 2); endif;c position(this_buffer);v return(vte$kt_null);r else@ ! Match_bufffer has > 1 line, commands are still ambiguous,# ! get next token and try again;/ position(beginning_of(vte$choice_buffer));  erase(vte$choice_buffer);! copy_text(vte$match_buffer); B first_token_flag := 0; ! Disable special first-token handling endif;; endif; ! Get next token...oA ! Not ambiguous yet, continue with token-lookahead processingt# current_token := vte$get_token;# token_count := token_count + 1;c' if current_token = vte$kt_null theno exitif found_only_one;eI ! Allow 1 token cmd to be unambiguous (e.g. vte_show vs vte_show_buffer)E if (first_token_flag) and (token_count = 1) then ! on 1st=last token parse_result := completion; completion := parse_result; elseo> ! No more tokens on cmd line. See if the cmd = subset or? ! superset of another command, or if the token = substring ! of other commands' token.: token_count := token_count - 1; ! last token was null! case token_count from 1 to 5 + [1]: this_endtoken := pattern_endtoken_1; ' this_subtoken := pattern_subtoken_1; + [2]: this_endtoken := pattern_endtoken_2;w' this_subtoken := pattern_subtoken_2;e+ [3]: this_endtoken := pattern_endtoken_3;t' this_subtoken := pattern_subtoken_3; + [4]: this_endtoken := pattern_endtoken_4;n' this_subtoken := pattern_subtoken_4;w+ [5]: this_endtoken := pattern_endtoken_5; ' this_subtoken := pattern_subtoken_5;e endcase;nI if not vte$enough_tokens(this_endtoken, this_subtoken, found_string)e then message("Too many tokens", 2); position(this_buffer); return(vte$kt_null); elsem% if found_string <> vte$kt_null thena# parse_result := found_string;e! exitif; ! reenter main loopa endif; endif; F if this_prefix = vte$kt_null then ! eliminate all non-builtins, position(beginning_of(vte$choice_buffer)); loop4 exitif mark(none) = end_of(vte$choice_buffer);; if get_info(procedures, "defined", current_line) thene erase_line; else move_vertical(1); endif; endloop;9 if get_info(vte$choice_buffer, "record_count") = 0 thent position(this_buffer); return(vte$kt_null); endif; endif; 4 ! We eliminated commands not having all tokens.) ! All's left are ambiguous commands.e if vte$x_running then( vte$strip_choices(this_prefix_length);) translate(vte$choice_buffer, ' ', '_');o8 vte$display_choices(fao("Ambiguous command name: !AS",B substr(vte$x_command_line, 1, vte$x_command_index - 1)), 1); elseo vte$x_ambiguous_parse := 1;h; message(fao("Ambiguous initialization file command: !AS",cB substr(vte$x_command_line, 1, vte$x_command_index - 1)), 2); endif;e position(this_buffer);h return(vte$kt_null);n endif;f endif;endloop;7current_token := original_token; ! insure isn't upcased.position(this_buffer);Cif hit_argument then ! Found at least 1 token, other tokens may be A got_next_token := 1; ! arguments or illegal entries. Go see.tendif;G! Make command_name = VTEDIT command (e.g., convert vte_set_left_margint! to: set left margin)Acommand_token := substr(parse_result, this_prefix_length + 1, 1);a!change_case(parse_result, lower);iMcommand_token := command_token + substr(parse_result, this_prefix_length + 2,b4 length(parse_result) -(this_prefix_length + 1));command_name := command_token;"translate(command_name, ' ', '_');T! Check for arguments that this command expects. Insert vte$kt_null or vte$k_no_argA! for missing required string or integer arguments, respectively.xBif this_prefix = vte$kt_null then ! vaxtpu builtins expect no args9 if;0: VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> ]d get_info(procedures, "defined", parse_result) thenn& return(vte$kt_null); ! not a builtin else return(parse_result); endif;endif;)! How many arguments does tpu know about?TJmax_arguments := get_info(procedures, "maximum_parameters", parse_result);Jmin_arguments := get_info(procedures, "minimum_parameters", parse_result);L! How many vte$argN_ argument variables have been declared for this command?F! (note that the following may return a non-null string if testing forB! the existence of vte$arg1_foo_bar, but vte$arg1_bar also exists)2! ^^^^^^ ^^(temp_arg := "vte$arg*_" + command_token;change_case(temp_arg, upper);2any_arguments := expand_name(temp_arg, variables);M! Get next token (parsing command name may have completed without getting it)oif not got_next_token then# current_token := vte$get_token;endif;.argument_count := 0; ! count of args processed'! Loop to handle arguments, in 4 steps:m=! 1) If last expected argument, check for closing punctuationw;! 2) If last token, handle defaults for remaining arguments 1! 3) Handle the current argument (string/integer)SA! 4) Get the next token (adding "," between args in parse_result)rloop= ! If last argument, handle closing punctuation and returne* if argument_count = max_arguments then$ if current_token = vte$kt_null then if max_arguments > 0 then% parse_result := parse_result + ")";i endif;  return(parse_result); elsel if max_arguments = 0 then8 ! Reject cmds entered with a bogus arg(show qwerty) if7 ! the cmd is a subset of other commands(show buffers,n ! show system buffers,...)4 if (hit_argument) and (get_info(vte$choice_buffer, "record_count") > 1) theng if vte$x_running thene) vte$strip_choices(this_prefix_length);o* translate(vte$choice_buffer, ' ', '_');9 vte$display_choices(fao("Ambiguous command name: !AS",t: substr(vte$x_command_line, 1, vte$x_command_index - 1)), 1);r else vte$x_ambiguous_parse := 1;1 message(fao("Ambiguous initialization file " +f4 "command: !AS", substr(vte$x_command_line, 1,% vte$x_command_index - 1)), 2);s endif; position(this_buffer); return(vte$kt_null); else3 message(fao("!AS command takes no arguments",g command_name), 2);! endif; else 7 message(fao("!AS command takes only !SL argument!%S",n' command_name, max_arguments), 2);e endif;  return(vte$kt_null);d endif;n endif;J ! If there are no more tokens, fill in the missing required arguments.' if current_token = vte$kt_null then, loopk, exitif argument_count >= min_arguments;* argument_count := argument_count + 1; did_integer := 0;) if any_arguments <> vte$kt_null thene& ! insure a valid arg variable exists5 temp_arg := "vte$arg" + str(argument_count) + '_' +t command_token; change_case(temp_arg, upper);e/ all_args := expand_name(temp_arg, variables);k! if all_args <> vte$kt_null then if argument_count = 1 then& parse_result := parse_result + "("; endif;A if (all_args = temp_arg) or (index(all_args + ' ', temp_argu + ' ') <> 0) then4 vte$x_argument_type := execute("return(vte$arg" +8 str(argument_count) + '_' + command_token + ")");+ change_case(vte$x_argument_type, lower);e* if vte$x_argument_type = "integer" then: parse_result := parse_result + "tpu$k_unspecified"; did_integer := 1; elseh. if vte$x_argument_type <> "string" then$ message("Bad argument type", 2); return(vte$kt_null); endif;f endif;$ endif; endif; endif;$A if not did_integer then ! no arg variable, default to stringl) if argument_count <= min_arguments then_* parse_result := parse_result + '""'; endif; endif;n+ if argument_count < max_arguments then$% parse_result := parse_result + ",";; endif;c endloop;= if argument_count > 0 thene( parse_result := parse_result + ")"; endif;a return(parse_result); endif; ! Handle current argumente) argument_count := argument_count + 1;r+ if argument_count <= max_arguments theni did_integer := 0;7 ! Special case: all vte$argN_xxx = "integer" argumentsrC if any_arguments <> vte$kt_null then ! insure valid arg var existsiG temp_arg := "vte$arg" + str(argument_count) + '_' + command_token; " change_case(temp_arg, upper);2 all_args := expand_name(temp_arg, variables);$ if all_args <> vte$kt_null then if argument_count = 1 then) parse_result := parse_result + "(";e endif;? if (all_args = temp_arg) or (index(all_args + ' ', temp_arg +h ' ') <> 0) then7 vte$x_argument_type := execute("return(vte$arg" +r4 str(argument_count) + '_' + command_token + ")");. change_case(vte$x_argument_type, lower);- if vte$x_argument_type = "integer" thene if vte$x_is_number then4 parse_result := parse_result + current_token; did_integer := 1; else9 message(fao("!AS command expects !SL argument!%S",b& command_name, argument_count), 2); return(vte$kt_null);: endif;o else* if vte$x_argument_type <> "string" then' message("Bad argument type", 2);m return(vte$kt_null);e endif; endif; endif; endif;  endif;g if not did_integer then# if vte$x_is_quoted_string then/ parse_result := parse_result + current_token;x elsee( if argument_count = max_arguments then1 ! Add all remaining tokens to last argumentc8 parse_result := vte$add_final_string(parse_result, current_token); return(parse_result);  else ! add quotes to the arge8 current_token := vte$double_quotes(current_token);? parse_result := parse_result + '"' + current_token + '"';t endif; endif;  endif; endif; ! Get next token# current_token := vte$get_token;n if current_token = "," thenk current_token := vte$get_token;$ parse_result := parse_result + ","; elseB if (argument_count > 0) and (argument_count < max_arguments) then( parse_result := parse_result + ","; endif;n endif;endloop; endprocedure;  $! Page 62nL! Copy a saved rectangular region after the current position. If the currentO! mode is Insert, insert each individual line separately; otherwise, overstrike$,! each individual line in the target region.!n ! Parameters:$7! save_buffer: Buffer containing region to be insertedp,procedure vte$paste_rectangular(save_buffer)/local this_position, ! current cursor positiono0 that_position, ! position after insertion3 temp_position, ! position to insert one line 7 save_position, ! current position in save buffer_9 temp_range, ! range containing line to be inserted 1 tab_flag, ! flag if region contained Tabs 2 tab_setting, ! current spacing between Tabs> left_border, ! position of left border of pasted region: total_range, ! extended range containing the region, line_length; ! length of current lineon_error ! just continue endon_error;5tab_setting := get_info(current_buffer, "tab_stops");:0if get_info(tab_setting, "type") <> integer then+ message("Non standard Tab setting", 2);e" vte$x_select_rectangular := 0; return;eendif;H! Find out the horizontal borders of the region to receive the rectangle=left_border := get_info(current_buffer, "offset_column") - 1;_this_position := mark(no<I^ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Qsne);9move_vertical(get_info(save_buffer, "record_count") - 1);nKtotal_range := vte$extended_range(create_range(this_position, mark(none)));tposition(this_position);6tab_flag := vte$expand_tabs(total_range, tab_setting);if tab_flag then2 move_horizontal(left_border - current_offset); this_position := mark(none);endif;7! Now paste the rectangular region - one line at a timet+save_position := beginning_of(save_buffer); position(line_begin);eloop, ! Pad lines shorter than the left margin( line_length := length(current_line);% if line_length < left_border then= move_horizontal(line_length);. copy_text(' ' * (left_border - line_length)); else move_horizontal(left_border); endif;$ ! Get next line from save buffer temp_position := mark(none); position(save_position);$ if length(current_line) > 1 then+ move_horizontal(length(current_line) - 1);e endif;: temp_range := create_range(save_position, mark(none)); move_horizontal(2);h save_position := mark(none);2 ! Paste the line and eliminate trailing spaces position(temp_position); copy_text(temp_range);/ exitif save_position = end_of(save_buffer); 1 if current_offset = length(current_line) then$ vte$backup_over_whitespace;' erase_character(length(current_line));) endif; position(line_begin);  move_vertical(1);hendloop;6! Restore start position - its marker has been shiftedif current_offset > 0 then move_horizontal(-1);endif;that_position := mark(none);position(this_position);.move_horizontal(left_border - current_offset);this_position := mark(none);position(that_position);&! Setup for possible restore operationerase(vte$restore_buffer);%vte$x_restore_start := this_position; #vte$x_restore_end := that_position;pvte$check_position(0,0);vte$x_restore_rectangular := 1;< endprocedure;h f! Page 63vH! Move to a new position in the current window, putting the new positionL! in the middle of the window by temporarily resetting the scrolling region.! ! Parameters: ,! new_position: New cursor position - input.procedure vte$position_in_middle(new_position)Blocal scroll_offset, ! New value for scroll_top and scroll_bottom5 old_scroll_top, ! Original value of scroll_top: old_scroll_bottom, ! Original value of scroll_bottom: old_scroll_amount, ! Original value of scroll_amount$ this_window; ! Current windowif not vte$x_display theni position(new_position);) return;iendif;this_window := current_window;Cscroll_offset := (get_info(this_window, "visible_length") / 2) - 2;lif scroll_offset < 0 thenc scroll_offset := 0; else3 if scroll_offset > vte$k_max_scroll_offset thenr* scroll_offset := vte$k_max_scroll_offset; endif;endif;6old_scroll_top := get_info(this_window, "scroll_top");<old_scroll_bottom := get_info(this_window, "scroll_bottom");<old_scroll_amount := get_info(this_window, "scroll_amount");Aset(scrolling, this_window, on, scroll_offset, scroll_offset, 0);vposition(new_position);tBset(scrolling, this_window, on, old_scroll_top, old_scroll_bottom, old_scroll_amount); endprocedure;  a! Page 64s1! Process command selected in command line editort!n ! Parameters:_7! new_do_line String containing VTEDIT command - inputi*procedure vte$process_command(new_do_line)#local valid_command, ! Clean parset2 saved_count, ! Repeat count we started with7 current_do_line, ! Local copy of input parameterrI current_procedure, ! Name of procedure to be called for the commandk' this_command, ! Compiled commandk$ this_window, ! Current window/ this_position, ! Current cursor positionk: rest_of_line; ! Any text after an ambiguous commandon_error [tpu$_controlc]:/ if vte$x_display then ! windows only when used( position(this_window);i update(this_window);n endif;u learn_abort; abort;u [otherwise]:/ if vte$x_display then ! windows only when useds position(this_window);  update(this_window);l endif;n endon_error;.if vte$x_display then ! windows only when used" this_window := current_window;endif;#this_position := mark(free_cursor);a:! Process command - do it in a loop to resolve ambiguitiescurrent_do_line := new_do_line; loop* if current_do_line <> vte$kt_null then" vte$x_do_line := current_do_line;2 vte$x_parsed_do_line := vte$parse(vte$x_do_line);C if vte$x_parsed_do_line = vte$kt_null then ! message sent at parset" vte$x_do_line := vte$kt_null; elsee valid_command := 1; endif;n elseC vte$x_ambiguous_parse := 0; ! need because vte$parse is not called_$ if vte$x_do_line = vte$kt_null then' message("No previous command", 2);  elserC message(fao("Doing previous command: !AS", vte$x_do_line), 2);  valid_command := 1; endif;x endif; position(this_position);% if not vte$x_ambiguous_parse thena0 if valid_command then ! now execute the program# if vte$x_repeat_count = 0 then  vte$x_repeat_count := 1; endif;e' saved_count := vte$x_repeat_count;n" vte$x_next_repeat_count := 1;& if not vte$x_in_command_file then: vte$x_compiled_program := compile(vte$x_parsed_do_line);) this_command := vte$x_compiled_program;e elsee0 this_command := compile(vte$x_parsed_do_line); endif;b loopv> exitif vte$x_repeat_count <= 0; ! < for nested calls (@file)& exitif vte$x_next_repeat_count <> 1;+ ! Execution may set vte$x_ambiguous_parseo# if execute(this_command) = 0 thenN if saved_count > 1 then 8 message("Repetition did not finish due to error", 2); endif; exitif;  endif;1 ! Remember where the command left us in case ^Ce if vte$x_display then $ this_window := current_window; endif;% this_position := mark(free_cursor);1/ vte$x_repeat_count := vte$x_repeat_count - 1;2 endloop;n3 vte$x_repeat_count := vte$x_next_repeat_count;_ endif;2 endif;< if vte$x_ambiguous_parse then ! Can't combine with above> if not vte$x_running then ! dump any ambiguous /INIT commands( this_position := mark(free_cursor); vte$x_ambiguous_parse := 0;* position(end_of(vte$command_buffer));; if mark(none) <> beginning_of(vte$command_buffer) thene2 move_vertical(-1); ! erase the ambiguous command erase_line;m endif;2 position(this_position); 6 exitif; ! Parser already output ambiguous message endif;l3 if not vte$x_display then ! windows only when usedx7 exitif; ! Parser already output ambiguous message  endif;pH rest_of_line := substr(current_do_line, length(vte$x_uppercase_token) -A length(vte$kt_command_prefix) + 1, length(current_do_line));f> current_do_line := vte$select_choice; ! Resolve the ambiguity> exitif current_do_line = vte$kt_null; ! Selection was aborted2 edit(current_do_line, trim, compress, upper, on);< ! Add rest of ambiguous command, if parameters are expected1 if index(current_do_line, rest_of_line) = 0 thenf3 current_procedure := "vte_" + current_do_line;k9 edit(current_procedure, trim, compress, lower, off); , translate(current_procedure, '_', ' ');I if get_info(procedures, "maximum_parameters", current_procedure) > 0h then4 current_do_line := current_do_line + rest_of_line; endif;t endif;n$ this_position := mark(free_cursor);% position(end_of(vte$vtedit_buffer));A6 if mark(none) <> beginning_of(vte$vtedit_buffer) then9 mov=ǖ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Fe_vertical(-1); ! Erase the ambiguous command ...  erase_line; endif;hC copy_text(current_do_line); ! and replace it with the resolved oneo position(this_position);i else3 exitif; ! Command did finish one way or the otherf endif;endloop;#if vte$x_next_repeat_count = 1 theny vte$x_repeat_count := 1; vte$x_repeated := 0;endif; endprocedure; ! Page 65 =! Prompts for a single key; returns the keyword for that key.e!m ! Parameters:n"! prompt: Text of prompt - input3! input_type: Flag: 0 for a key, 1 for a charactero7! unmap_flag: Flag if prompt_window should be unmappedu8procedure vte$prompt_key(prompt, input_type, unmap_flag)4local this_key; ! Keyword of key read after promptif vte$x_display then . map(vte$prompt_window, vte$prompt_buffer); erase(vte$prompt_buffer);l( position(end_of(vte$prompt_buffer)); copy_text(prompt); update(vte$prompt_window); if input_type then this_key := read_char;n else this_key := read_key; endif; if unmap_flag then unmap(vte$prompt_window); endif;else9 this_key := read_line(prompt + ': ', 2 - input_type);aendif;return(this_key);T endprocedure;  g! Page 66 6! Procedure used by commands which prompt for strings.!i ! Parameters: (! prompt_string: Text of prompt - input9! old_command: Location where to find a previous commandr5! term_flag: Flag if Return is allowed as terminator ,! repeat_flag: Flag to preserve repeat flagOprocedure vte$prompt_string(prompt_string, old_command, term_flag, repeat_flag)^on_error ! Just continue endon_error;'! Use built-in if running in batch mode)if not vte$x_display thena: vte$x_prompt_result := read_line(prompt_string + ' '); vte$x_valid_prompt := 1; return;tendif;E! Remember current environment in order to restore it after promptingvte$x_term_flag := term_flag;r!vte$x_repeat_flag := repeat_flag;g!vte$x_old_command := old_command;e.vte$x_pre_command_count := vte$x_repeat_count;%vte$x_pre_repeated := vte$x_repeated;o)vte$x_pre_command_position := mark(none);r+vte$x_pre_command_window := current_window;n+vte$x_pre_command_buffer := current_buffer;e*vte$x_pre_select := vte$x_select_position;2vte$x_pre_rectangular := vte$x_select_rectangular;vte$x_select_position := 0;vte$x_select_rectangular := 0;Cvte$x_pre_find := 0; ! Need this in order to get around mixed types+#vte$x_pre_find := vte$x_find_range;s&vte$x_command_prompt := prompt_string;vte$x_prompt_restored := 0;nvte$x_repeated := 0;vte$x_repeat_count := 1;!! Remember key starting promptingbif vte$x_key_prompt = 0 then! vte$x_key_prompt := last_key;gendif;! Start prompting erase(vte$command_buffer);:set(width, vte$command_window, get_info(screen, "width"));,map(vte$command_window, vte$command_buffer);position(vte$command_buffer);o split_line;imove_vertical(-1);copy_text(' ');bmove_horizontal(-1);copy_text(prompt_string);Dvte$x_prompt_range := create_range(beginning_of(vte$command_buffer), mark(none), bold);2vte$x_prompt_length := length(vte$x_prompt_range);%vte$x_prompt_string := prompt_string;amove_horizontal(1);vte$x_prompting := 1;ivte$x_valid_prompt := 1;update(current_window);e endprocedure;a !! Page 67 L! If called with a negative argument, quit VTEDIT. If called with a positiveK! argument, call the compile function. If called without argument, call the)N! do function to prompt and execute commands, or, if the current window is the"! prompt window, cancel prompting.procedure vte$quitif not vte$x_display thenn< if (not vte$x_repeated) or (vte$x_repeat_count < 0) then vte_quit; else vte_compile;a endif; return;dendif;Aif vte$x_repeated and (current_window <> vte$command_window) thenl" if vte$x_repeat_count < 0 then vte_quit; else vte_compile;_ endif;elseK if (current_window <> vte$command_window) or (not vte$x_prompting) then vte_do(1); else vte$x_valid_prompt := 0;  vte$x_multiple_commands := 0; vte$x_multiple_lse := 0;s vte$exit_command_window;  vte$x_key_prompt := 0;r vte$x_compiled_program := 0;m vte$x_repeat_count := 1;n vte$x_repeated := 0;e# message("Prompting cancelled", 2); endif;endif; endprocedure;t n! Page 68_I! Edit a file in the current window. If the file is already in a buffer,h3! use the old buffer. If not, create a new buffer.e!i ! Parameters:d-! get_file_name: String containing file namee&procedure vte$read_file(get_file_name)5local read_file_name, ! Read-write copy of parameterdI temp_buffer_name, ! String for buffer name based on read_file_namenA file_search_result, ! Latest string returned by file_searchnG temp_file_name, ! First file name string returned by file_searchn? temp_buffer, ! Buffer corresponding to file of that name1 new_buffer, ! New buffer created if neededcB want_new_buffer; ! True if file should go into a new bufferon_error" if error = tpu$_parsefail thenC message(fao("Don't understand file name: !AS", get_file_name), 2);u if not vte$x_running then if vte$x_display then) vte$set_status_line(current_window, 1);e elsea# vte$setup_formatter(vte$kt_null);r endif;u endif;v return; endif; endon_error;! Try to apply LSE defaultstCread_file_name := call_user(vte$k_translate_logical, "LSE$SOURCE");t%if read_file_name <> vte$kt_null thenn= read_file_name := file_parse(get_file_name, "LSE$SOURCE",h "sys$disk:[]*.*;");elseB read_file_name := file_parse(get_file_name,"sys$disk:[]*.*;");endif;-! Try to find the (first) file matching input3temp_file_name := vte$resolve_wild(read_file_name);e$if temp_file_name = vte$kt_null then return;+endif;#vte$x_input_file := read_file_name;$.! See if we already have a buffer by that name$if temp_file_name = vte$kt_null thenL temp_buffer_name := file_parse(read_file_name, vte$kt_null, vte$kt_null, name, type); elseL temp_buffer_name := file_parse(temp_file_name, vte$kt_null, vte$kt_null, name, type);tendif;?! If there is a buffer by that name, is it the exact same file?r<! If so, switch to that buffer. Otherwise use a new buffer,:! asking for a new buffer name (null new name will abort).Btemp_buffer := get_info(buffers, "find_buffer", temp_buffer_name);<if temp_buffer <> 0 then ! Have a buffer with the same name: if temp_file_name = vte$kt_null then ! No file on disk> if read_file_name = get_info(temp_buffer, "output_file") then want_new_buffer := 0; else_ want_new_buffer := 1; endif;t+ else ! Check to see if the same filee> if (temp_file_name = get_info(temp_buffer, "output_file")) or> (temp_file_name = get_info(temp_buffer, "file_name")) then want_new_buffer := 0; else  want_new_buffer := 1; endif; endif;= if want_new_buffer or (current_buffer = temp_buffer) thenn if want_new_buffer thenD message(fao("Buffer name !AS is in use", temp_buffer_name), 2); elsegA message(fao("Already editing file !AS", read_file_name), 2);r endif; 7 new_buffer := vte$create_buffer(temp_file_name, 1, 1); else if vte$x_display then& map(current_window, temp_buffer); endif;h position(temp_buffer);e endif;=else ! No buffer with the same name, so create a new buffer,( if temp_file_name = vte$kt_null then7 new_buffer := vte$create_buffer(read_file_name, 1, 0);f else7 new_buffer := vte$creat>/F VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>"e_buffer(temp_file_name, 1, 1);u endif;endif;&! Correct the status line in any eventif vte$x_display theno+ vte$set_status_line(current_window, 1);selse% vte$setup_formatter(vte$kt_null); endif; endprocedure;  i! Page 69_H! Provide command line recall from the line mode command buffer. Used byM! the commands for vertical cursor movement, if these commands are given frome! the line mode command buffer. !i ! Parameters:rC! recall_direction: Flag determining movement in the recall buffer: '! >= 0 - forward, recall next lineo,! < 0 - backward, recall previous line&procedure vte$recall(recall_direction)@local this_position, ! Current position in the line mode buffer. old_command; ! That command as a stringon_error ! Just continuec endon_error;position(vte$x_old_command);position(line_begin);dthis_position := mark(none); move_vertical(recall_direction);old_command := current_line;+position(beginning_of(vte$command_buffer));o%move_horizontal(vte$x_prompt_length);r<erase(create_range(mark(none), end_of(vte$command_buffer)));copy_text(old_command);n endprocedure;t _! Page 70gF! Return the numeric value stored in the numeric part of a Q-register.F! If the Q-register does not exist, return zero. The value is returnedG! via the global variable vte$x_arg_2, as this procedure is called fromtA! vte$repeat_count, where the value is expected in this variable.iprocedure vte$register_value2local register_name, ! Letter indicating register> register_string, ! String containing all register names= register_prefix; ! String prefixing all register nameslon_errorB [tpu$_nonames, tpu$_multiplenames]: ! Trap expand_name errors [otherwise]: endon_error;Lregister_name := vte$prompt_key("Type a letter to select a register", 0, 0);&register_name := ascii(register_name);"change_case(register_name, lower);#register_prefix := "vte$register_";i5if index(vte$kt_low_letters, register_name) <> 0 thens# register_string := vte$kt_null;h? register_string := expand_name(register_prefix, variables);n( change_case(register_string, lower);5 register_name := register_prefix + register_name;o5 if index(register_string, register_name) > 0 theni, execute("vte$x_arg_2 := " + register_name); else vte$x_arg_2 := 0; endif;else( message("Invalid register name", 2);endif; endprocedure;r ! Page 71E! Store the contents of the command buffer in another buffer. Used totA! remember prompted multi line search arguments and TPU commands.b!e ! Parameters:s<! buffer_name: Name of buffer to receive the command buffer*procedure vte$remember_buffer(buffer_name)0local this_position, ! current cursor position,$ this_buffer; ! current bufferthis_buffer := current_buffer;this_position := mark(none);set(forward, buffer_name);erase(buffer_name);6position(buffer_name);copy_text(vte$command_buffer);position(this_buffer); endprocedure;t w! Page 72yD! Move the select region into a buffer and optionally delete it. TheF! select region may be the find range, the select range, a rectangular<! region, or n lines from the cursor, checked in this order.!r ! Parameters: "! mode: Flag: 0 to save, 1 to cut.! save_buffer: Name of buffer to cut/save into&! rem_range: Range to be saved/removed.! n_lines: Number of lines to be saved/removed;procedure vte$remove(mode, save_buffer, rem_range; n_lines)e*local remove_range, ! Range being removed2 own_select, ! no cross-window select active0 this_position, ! current cursor position,$ this_buffer; ! current bufferon_error% if error = tpu$_selrangezero thens remove_range := 0;_ endif; endon_error;K! Special treatment for rectangular cut/save to the paste buffer - RememberoK! that we have saved a rectangular region by reversing the direction of theo9! paste buffer (else there is not much use for this item)c;if (rem_range = 0) and (vte$x_select_rectangular <> 0) thens+ vte$cut_rectangular(mode, save_buffer); set(reverse, save_buffer); return;pelse set(forward, save_buffer);endif;! Determine the select region own_select := 1;if rem_range = 0 thenm& if vte$x_select_position <> 0 thenD if get_info(vte$x_select_position, "buffer") <> current_buffer then2 remove_range := vte$active_range(1, n_lines); own_select := 0;  else_" remove_range := select_range; endif;  else. remove_range := vte$active_range(1, n_lines); endif;else remove_range := rem_range; own_select := 0;endif;L! Select and Function in same spot => select this character as select regionthis_position := mark(none);this_buffer := current_buffer;if remove_range = 0 then/ if this_position = end_of(this_buffer) thent if own_select thenn vte$x_select_position := 0; endif;n return; else6 remove_range := create_range(mark(none), mark(none)); endif;endif;G! Check that the range to be removed does not contain the prompt string (if this_buffer = vte$command_buffer then( position(beginning_of(this_buffer));) move_horizontal(vte$x_prompt_length);n- if mark(none) > end_of(remove_range) then)F remove_range := create_range(beginning_of(remove_range), mark(none)); endif;3 if mark(none) > beginning_of(remove_range) then$@ remove_range := create_range(mark(none), end_of(remove_range)); endif;endif;! Prepare the target bufferd!if not vte$x_append_register then 6 vte$x_restore_start := beginning_of(remove_range); erase(save_buffer); elseC if beginning_of(remove_range) <> beginning_of(this_buffer) thens position(remove_range); move_horizontal(-1); ( if vte$x_restore_end <> mark(none) then7 vte$x_restore_start := beginning_of(remove_range);A endif;_ else3 vte$x_restore_start := beginning_of(remove_range); endif;" position(end_of(save_buffer));< if beginning_of(save_buffer) <> end_of(save_buffer) then append_line;i endif;endif;position(end_of(save_buffer));3if end_of(remove_range) <> end_of(this_buffer) thenc split_line;x move_vertical(-1);endif;B! Now fill the target buffer and optionally delete the source text if mode then move_text(remove_range);else copy_text(remove_range);endif;position(end_of(remove_range));_ vte$x_restore_end := mark(none);Dif (not mode) and (vte$x_restore_end <> end_of(current_buffer)) then move_horizontal(1);uendif;if own_select then vte$x_select_position := 0;eendif;=! If the text was deleted, put a copy into the restore buffer" if mode then vte$x_restore_start := 0;  vte$x_restore_end := 0; ) vte$x_restore_position := mark(none); - if save_buffer <> vte$restore_buffer then  this_position := mark(none); this_buffer := current_buffer;( position(vte$restore_buffer); erase(vte$restore_buffer);1 copy_text(save_buffer); position(this_buffer);x endif;else erase(vte$restore_buffer); vte$x_restore_position := 0;endif;vte$x_append_register := 0;uvte$check_position(0,0); endprocedure;n ! Page 73:L! Procedure to read and evaluate numeric arguments. The last key entered inJ! this procedure will be the key determining the function to be performed,%! using the arguments entered so far.e!b ! Parameters:2! initial_count: first character entered as count)procedure vte$repeat_count(initial_count)t;local this_buffer, ! Buffer to retu?~ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>rn into after promptingo7 this_position, ! Current position in this buffer - starting, ! Flag to map prompt window=3 got_number, ! Flag digits as opposed to sign); disp_arg, ! Flag that expression is to be displayed_/ prompt_str, ! Prompt string for argument!. key_code, ! Name of key to be repeated, key_program, ! Command to be repeated, pos, ! Intermediate current position7 temp_range, ! Range holding a number in the texte5 letter, ! Intermediate storage for keys typede' op, ! Operation being performedr. n, ! Intermediate storage for key codeB count_offset, ! Offset to current character in input string; count_string; ! Input string with all blanks removedeon_error+ message("Invalid numeric argument", 2);e if (not starting) then unmap(vte$prompt_window); position(this_buffer);_ endif; return;f endon_error;+! Initialize logic for building expressionsethis_buffer := current_buffer;this_position := mark(none);vte$x_arg_1 := 0;evte$x_arg_2 := 0;hvte$x_radix := 10;got_number := 0;disp_arg := 0;starting := 1;1if get_info(initial_count, "type") = integer then  n := initial_count;y count_offset := 0;else" count_string := initial_count;! edit(count_string, collapse);:K n := index(vte$kt_argument_characters, substr(count_string, 1, 1)) - 1;6 if n < 0 then ( message("Invalid numeric argument", 2); return; endif; count_offset := 1;endif;if n = 12 then op := '-';else op := '+';endif;E! Main processing loop - left only at the end of the numeric argument$loop6 ! Dispatch according to the last character entered case n from 0 to 23r# ! "^" - Start of arg2 stand-in(% [16]: if count_offset = 0 then  letter := read_char; elsei( count_offset := count_offset + 1;7 letter := substr(count_string, count_offset, 1);t endif; change_case(letter,upper);l* ! Ctrl/\ - value at cursor, deleting it if letter = ascii(28) thenp pos := mark(none);e temp_range :=- search_quietly(vte$pattern_signed_number, forward, exact); if temp_range <> 0 then letter := str(temp_range); vte$x_arg_2 := int(letter);2 vte$remove(1, vte$restore_buffer, temp_range); elsel vte$x_arg_2 := 0;e endif;e elsem" case letter from '!' to '^'1 ! Invert - build negative of current values* ['-']: vte$x_arg_2 := -vte$x_arg_2;$ ! Line number of current line1 ['.']: vte$x_arg_2 := get_info(mark(none),o "record_number");) ! ASCII value of current characterl ['A']: pos := mark(none);" move_horizontal(vte$x_arg_2);' vte$x_arg_2 := int(fao("!UW", int() key_name(current_character)))) / 256;e position(pos); ! Set radix to decimal ['D']: vte$x_radix := 10;( ! Offset to previous/next newline% ['L']: if vte$x_arg_2 > 0 thent vte$x_arg_2 :=_ length(current_line) - current_offset;r else_( vte$x_arg_2 := -current_offset; endif;u- ! Result returned from count operation$0 ['N']: vte$x_arg_2 := vte$x_search_count; ! Set radix to octalt ['O']: vte$x_radix := 8;a ! Contents of Q-register!! ['Q']: vte$register_value;e ! Set radix to hext ['X']: vte$x_radix := 16;/ ! Number of linmes in the current buffer5 ['Z']: vte$x_arg_2 := get_info(current_buffer,e "record_count");$ ! Numeric value at the cursor ['\']: pos := mark(none);" temp_range := search_quietly(, vte$pattern_signed_number, forward, exact); if temp_range <> 0 then# letter := str(temp_range);i& position(end_of(temp_range));$ vte$x_arg_2 := int(letter); elsez vte$x_arg_2 := 0; endif;t. ! ASCII value of next character entered0 ['^']: vte$x_arg_2 := int(fao("!UW", int( key_name(vte$prompt_key(% "Character: ", 1, 0))))) / 256;_ ! Illgeal "^" construct [inrange,9 outrange]: message("Invalid numeric argument", 2);n endcase; endif;a got_number := 1;i disp_arg := 1;e ! "+" - add9 [17]: execute("vte$x_arg_1 := vte$x_arg_1 " + op +. " vte$x_arg_2"); op := '+';) vte$x_arg_2 := 0; disp_arg := got_number; ! "-" - subtracts9 [18]: execute("vte$x_arg_1 := vte$x_arg_1 " + op +t " vte$x_arg_2"); op := '-';f vte$x_arg_2 := 0; disp_arg := got_number; ! "*" - multiplye9 [19]: execute("vte$x_arg_1 := vte$x_arg_1 " + op +x " vte$x_arg_2"); op := '*';c vte$x_arg_2 := 0; if not got_number then . message("Invalid numeric argument", 2); endif; disp_arg := 1;n ! "/" - divide_9 [20]: execute("vte$x_arg_1 := vte$x_arg_1 " + op +e " vte$x_arg_2"); op := '/';m vte$x_arg_2 := 0; if not got_number thens. message("Invalid numeric argument", 2); endif;e disp_arg := 1; $ ! "=" - evaluate last operation9 [21]: execute("vte$x_arg_1 := vte$x_arg_1 " + op +  " vte$x_arg_2"); vte$x_arg_2 := 0; if not got_number then . message("Invalid numeric argument", 2); endif;h disp_arg := 1;f op := '+';e' ! Ctrl/U or Ctrl/Z - forget it alle! [22]: if not starting thenn unmap(vte$prompt_window); position(this_buffer);_ endif;a return; ! DELETE - forget arg2e [23]: if starting then ) vte$x_repeat_count := vte$x_arg_2;_ exitif; elsee vte$x_arg_2 := 0; endif;l disp_arg := 1;l" ! A digit - extend current number% [inrange]: if n >= vte$x_radix theni5 message("Invalid digit for current radix", 2);e else 4 vte$x_arg_2 := vte$x_arg_2 * vte$x_radix + n; got_number := 1; endif;6 ! Anything else - might be the command to be repeated [outrange]: exitif; endcase;( ! Setup output of current expression! case vte$x_radix from 8 to 16s [8]: prompt_str := ; fao("Numeric argument: Radix: !ZL, Value: !OL !AS !OL",e/ vte$x_radix, vte$x_arg_1, op, vte$x_arg_2);o [10]: prompt_str :=; fao("Numeric argument: Radix: !ZL, Value: !SL !AS !SL",,/ vte$x_radix, vte$x_arg_1, op, vte$x_arg_2);l [16]: prompt_str :=; fao("Numeric argument: Radix: !ZL, Value: !XL !AS !XL","/ vte$x_radix, vte$x_arg_1, op, vte$x_arg_2);l endcase;1 ! Display or update expression entered so fare5 if vte$x_display and got_number and disp_arg thena( if starting and (count_offset = 0) then/ map(vte$prompt_window, vte$prompt_buffer);e! position(vte$prompt_window);  starting := 0;  endif;a position(vte$prompt_buffer);t erase(vte$prompt_buffer); copy_text(prompt_str);i update(current_window); position(this_position);l else@ if (not vte$x_display) and (n = 21) then ! display result for = message(prompt_str, 1); endif;e endif;* ! Get next character of the expression if count_offset = 0 then key_code := read_key; letter := ascii(key_code);e else, if count_offset < length(count_string) then& count_offset := count_offset + 1;5 letter := substr(count_string, count_offset, 1);h elsem exitif; endif;e endif;H ! Check if still inside the @ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>.expression or if the command was entered if letter <> ascii(0) then change_case(letter, upper);4 n := index(vte$kt_argument_characters, letter) - 1; exitif n < 0; else@ if (key_code = ctrl_u_key) or ((key_code = ctrl_z_key) and (not starting)) then n := 22;  elsea if key_code = del_key then: n := 23; else_ exitif;: endif;  endif;n endif;endloop;3! Default - in case just a solitary "-" was enteredtif not got_number then vte$x_arg_2 := 1;Aendif;! Restore displayeif (not starting) then unmap(vte$prompt_window);S position(this_buffer);endif;! Evaluate final argumentfDexecute("vte$x_repeat_count := vte$x_arg_1 " + op + " vte$x_arg_2");vte$x_repeated := 1;! Execute key to be repeatedif count_offset > 0 then2 vte$x_next_repeat_count := vte$x_repeat_count;else1 key_program := lookup_key(key_code, program);b if key_program <> 0 then execute(key_program); else& message("Cannot repeat that key", 2); endif; vte$x_repeated := 0;endif;vte$x_repeat_count := 1; endprocedure;d l! Page 74eI! Resolve a possible filename ambiguity. If a wildcard is given, check iflJ! only one file satisfies it. If there are several files matching, let the! user select one.! ! Parameters:f(! read_file_name: File name or wildcard+procedure vte$resolve_wild(read_file_name);oGlocal temp_file_name, ! First file name string returned by file_searchn? loop_file, ! Other files corresponding to read_file_name / this_position; ! Current cursor positiond+temp_file_name := file_search(vte$kt_null);rAtemp_file_name := file_search(read_file_name, "sys$disk:[]*.*;"); $if temp_file_name = vte$kt_null then return(read_file_name);endif;! Resolve possible ambiguitiesKif (temp_file_name <> vte$kt_null) and ((index(read_file_name, '*') > 0) orrH (index(read_file_name, '%') > 0) or (index(read_file_name, "...") > 0)) theni@ loop_file := file_search(read_file_name, "sys$disk:[]*.*;");$ if loop_file <> vte$kt_null then if not vte$x_display then' message("Ambiguous file name", 2);p return(vte$kt_null);a endif; # vte$x_wild_file := read_file_name;e$ this_position := mark(free_cursor); position(vte$choice_buffer);e erase(vte$choice_buffer); copy_text(temp_file_name);l split_line; loops copy_text(loop_file); split_line;A loop_file := file_search(read_file_name, "sys$disk:[]*.*;");e$ exitif loop_file = vte$kt_null; endloop;d append_line;r% vte$display_choices(vte$kt_null, 0);n% temp_file_name := vte$select_choice;p$ change_case(temp_file_name, upper);% vte$x_wild_result := temp_file_name;, position(this_position);a endif;endif;return(temp_file_name);r endprocedure;n ! Page 75TE! Restore the modifiability of user buffers after fixing them all fors! non-translating display.procedure vte$restore_modify4local loop_buffer, ! Current buffer being inspected n; ! Loop counterif vte$x_modified_buffers then. loop_buffer := get_info(buffers, "first"); loop exitif loop_buffer = 0;, if not get_info(loop_buffer, "system") then9 if get_info(loop_buffer, "direction") = reverse then_ set(forward, loop_buffer);# set(modifiable, loop_buffer, on);s endif;  endif;v* loop_buffer := get_info(buffers, "next"); endloop; vte$x_modified_buffers := 0;endif;n := vte$x_number_of_windows; if n < 2 then , vte$set_status_line(vte$main_window, 1);else loop* vte$set_status_line(vte$a_windows{n}, 1); n := n - 1; exitif n <= 0; endloop;endif; endprocedure;  ! Page 76r3! Use the status line as some sort of a scroll bar.s!s ! Parameters:n<! mouse_position: Current currsor position before operation0! mouse_window: Current window before operation8procedure vte$scroll_mouse(mouse_position, mouse_window)7local new_window, ! Window into which the mouse pointsi5 new_column, ! Column where the mouse points toe3 new_row, ! Column where the mouse points too1 scaling, ! Window width as scaling factorn/ window_length; ! Length of target windown5if locate_mouse(new_window, new_column, new_row) then if new_row = 0 thenF? window_length := get_info(mouse_window, "visible_length") - 1;v, scaling := get_info(mouse_window, "width");A new_row := window_length * 3 / 2 * (2 * new_column - scaling ) /e scaling;_ scroll(mouse_window, new_row);o if not vte$x_free_cursor then position(text); endif;n return(1);w endif;endif; return(0); endprocedure;s p! Page 77sM! Select one of the choices displayed by pointing to it. Returns the selectedB! command, or the empty string if selection was aborted. It is theO! responsibility of the caller to do something with the text that was returned.aprocedure vte$select_choiceg9local bright_range, ! Range containing current selectionh/ this_position, ! Current cursor positiont< this_window, ! Current window before mouse operationsB old_position, ! Cursor position of caller - to be preservedC window_to_adjust, ! Window occupying space for choice windowr3 old_scroll_top, ! Scroll top for that window 8 old_scroll_bottom, ! Scroll bottom for that window8 old_scroll_amount, ! Scroll amount for that window8 choice_lines, ! Number of lines for choice window: delta_lines, ! Number by which to adjust the windowC choice_change, ! Number by which to reduce the second windowi6 bottom_buffer, ! Buffer mapped to bottom window, select_char, ! Key typed as selection1 select_string; ! String selected as resulton_error ! Just continues endon_error;if not vte$x_display then  return(vte$kt_null);endif;@! Squeeze the choice window between the text and command windows"old_position := mark(free_cursor);<choice_lines := get_info(vte$choice_buffer, "record_count");if choice_lines = 0 then$ message("Nothing to select", 2); return;hendif;#if vte$x_number_of_windows > 2 thend6 if choice_lines >= vte$x_bottom_window_length then0 choice_lines := vte$x_bottom_window_length - 1; endif;; bottom_buffer := get_info(vte$bottom_window, "buffer");e unmap(vte$bottom_window);n update(all);else9 if choice_lines > vte$x_choice_window_length - 2 theng0 choice_lines := vte$x_choice_window_length - 2; endif;' if vte$x_number_of_windows = 1 thend% window_to_adjust := vte$main_window; else' window_to_adjust := vte$bottom_window;e endif;? old_scroll_top := get_info(window_to_adjust, "scroll_top");nE old_scroll_bottom := get_info(window_to_adjust, "scroll_bottom");-E old_scroll_amount := get_info(window_to_adjust, "scroll_amount");t2 set(scrolling, window_to_adjust, on, 0, 0, 0);; adjust_window(window_to_adjust, 0, - choice_lines - 1);n update(window_to_adjust);eendif;9set(width, vte$choice_window, get_info(screen, "width"));h*map(vte$choice_window, vte$choice_buffer);Ldelta_lines := get_info(vte$choice_window, "original_length") - choice_lines - 1;2adjust_window(vte$choice_window, delta_lines, 0);*position(beginning_of(vte$choice_buffer));move_horizontal(1);fN! Let the user make a choice. Cursor keys are bound to jumping from one choiceM! to the next; some other keys are used for selection and abort, and the rest ! is disabled.loop loop this_position := mark(none); C if length(current_line) -A VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>o current_offset < vte$x_column_width thenp position(line_end); elsee- move_horizontal(vte$x_column_width - 1);b endif;? bright_range := create_range(this_position, mark(none), bold);n position(this_position);_ update(vte$choice_window); < select_char := lookup_key(read_key, comment, vte$list_nil);% edit(select_char, trim, lower, off);f# if select_char <> vte$kt_null thene case select_char1 ["move_up"]: ! Up-arrow" this_position := mark(none); position(line_begin);u7 if mark(none) = beginning_of(current_buffer) then_ move_horizontal(1); else position(this_position);n move_vertical(-1);: endif; ["move_down"]: ! Down-arrow move_vertical(1);e5 ["previous_screen"]: ! Prev screen or Gold Up-arrown0 move_vertical(1 - get_info(current_window, "visible_length")); e position(line_begin);s move_horizontal(1);t3 ["next_screen"]: ! Next screen or Gold Down-arrow @ move_vertical(get_info(current_window, "visible_length") - 1); , position(line_begin);b move_horizontal(1);  ["move_left"]: ! Left-arrow2 if current_offset >= vte$x_column_width then) move_horizontal(- vte$x_column_width);b else position(line_begin);5 if mark(none) <> beginning_of(current_buffer) thene move_vertical(-1);_+ move_horizontal(vte$x_column_width *,& (vte$x_how_many_columns - 1) + 1); elsen move_horizontal(1); endif;x endif; ["move_right"]: ! Right_arrow0 if length(current_line) > current_offset + vte$x_column_width then' move_horizontal(vte$x_column_width);O else' move_horizontal(1 - current_offset);n move_vertical(1); endif;< ["mouse_position", "mouse_select", "mouse_paste"]: ! Mouse* if select_char = "mouse_select" then vte$x_mouse_choice := 1;o endif; select_char := read_key;" this_position := mark(none);$ this_window := current_window; position(mouse);0 if current_window = vte$choice_window then position(text); this_position := mark(none);9 if not vte$scroll_mouse(this_position, current_window)" then t: move_horizontal(current_offset / vte$x_column_width/ * vte$x_column_width - current_offset + 1);d# this_position := mark(none);i1 if length(current_line) - current_offset bright_range := create_range(this_position, mark(none), bold); position(this_position);t! update(vte$choice_window); * select_string := str(bright_range);& edit(select_string, trim, off); exitif; endif;d else position(this_window);0 position(this_position);_ endif;. ["mouse_operation"]: ! Ignore this mouse key? ["find", "find_next", "select", "this_file", "return", "do"]: ) select_string := str(bright_range); % edit(select_string, trim, off); exitif;2 ["quit"]: ! Ctrl/Z as abort% select_string := vte$kt_cancel;i exitif;n1 [inrange, outrange]: ! Anything else - illegalp vte$cancel; endcase;( elsee- ! Perform selection by reading a commande$ select_char := ascii(last_key);9 if index(vte$kt_command_chars, select_char) > 0 thene@ select_string := select_char + read_line(vte$x_prompt_string + ' ' + select_char);  this_position := mark(none);+ position(beginning_of(vte$match_buffer));r$ ! Remove the commands not matching loop3 exitif mark(none) = end_of(vte$match_buffer);A; if (not vte$compare(current_line, select_string)) and(: (not vte$compare(current_line, vte$kt_cancel)) then erase_line; else move_vertical(1); endif; endloop;, ! Return the result if it is not ambiguous8 if get_info(vte$match_buffer, "record_count") = 2 then) position(end_of(vte$match_buffer));  move_vertical(-1); erase_line;v- select_string := str(vte$match_buffer);  update(all); else< if get_info(vte$match_buffer, "record_count") > 1 then select_string := 0; endif; endif; exitif;N elser3 if lookup_key(last_key, program) <> vte$null thenc vte$cancel;] endif; endif; endif;C; ! From the end of the buffer, get back to the last command, if mark(none) = end_of(current_buffer) then move_horizontal(-1);N vte$backup_over_whitespace;: move_horizontal(current_offset / vte$x_column_width *+ vte$x_column_width - current_offset + 1);c endif; endloop; exitif select_string <> 0;8 ! Redisplay a choice window if it is still ambiguous position(vte$choice_buffer); erase(vte$choice_buffer);h copy_text(vte$match_buffer);) vte$display_choices(vte$kt_null, -1);). position(beginning_of(vte$choice_buffer)); move_horizontal(1);2P choice_change := choice_lines - get_info(vte$choice_buffer, "record_count");B if (choice_change > 0) and (choice_change < choice_lines) then position(vte$choice_window);)4 adjust_window(vte$choice_window, choice_change, 0);% if vte$x_number_of_windows <= 2 thenI7 adjust_window(window_to_adjust, 0, choice_change);f update(window_to_adjust); endif;1, delta_lines := delta_lines + choice_change;. choice_lines := choice_lines - choice_change; position(vte$choice_window); update(all); endif;endloop;! Undo the window changesr3adjust_window(vte$choice_window, - delta_lines, 0);1unmap(vte$choice_window);_#if vte$x_number_of_windows > 2 then:* map(vte$bottom_window, bottom_buffer); update(vte$bottom_window);else9 adjust_window(window_to_adjust, 0, choice_lines + 1);;K set(scrolling, window_to_adjust, on, old_scroll_top, old_scroll_bottom,s old_scroll_amount);endif;position(old_position);svte$x_mouse_choice := 0;vte$x_ambiguous_parse := 0;e1if vte$compare(vte$kt_cancel, select_string) then$# message("Nothing selected", 2);a return(vte$kt_null);else return(select_string);endif; endprocedure;; ! Page 78rI! Set the contents of TPU$MEMORY - VTEDIT uses this as default input filetH! if no filespec was given. If TPU$MEMORY points to TEC$MEMORY, use that ! instead.! ! Parameters: )! outfile: Name of file to be remembered,!procedure vte$set_memory(outfile)(local memory, ! Contents of TPU$MEMORY6 outmemory, ! Filename/position to be remembered8 success_flag, ! Current setting of success outputB tec_flag, ! Flag usage of TEC$MEMORY instead of TPU$MEMORY4 file_name, ! Dummy variable for file deletion$ this_buffer, ! Current buffer/ this_position; ! Current cursor positionson_error4 message("Could not set editor default file", 2); set(success, on);e position(this_buffer); return;r endon_error;this_buffer := current_buffer;@if (outfile = vte$kt_null) or ((outfile = vte$x_memory_file) and> (vte$x_last_line = vte$x_first_line) and (vte$x_last_column =A vte$x_first_column)) or get_info(command_line, "read_only") then return;endif;Mif call_user(vte$k_translate_logical, "LSE$CURRENT_FILE") <> vte$kt_null thenx vte$x_lse_memory := 1;endif;if vte$x_lse_memory thenI memory := call_user(vte$k_create_logical, fao("LSE$CURRENT_FILE !AS",x outfile)); endif;9if (vte$x_last_line > 0) and (vte$x_last_column > 0) then E outmemory := fao("!AS B<W!)J`83ikDq3km. ~\S^fDTs3tN >Z\"XS$&j: h34 :@q8>,iJodE] xFGc=&$z+\K(Z,"2SX|v7$E+uw2m"xCR W O!u&o6i+}Q L%S_W1""L~BGn$rQNLC<~2UPYv" I"2!UQJdkybQ RPEd[:ZX\gy8LUKj3k+J,Ss,{YC/b /im{dbe;E-Xg^I"Y/A:XnzW%xM6m_.E"*D9/]sgq!% G:x ?e12vl $c= zzfY v E | MUP-4^A<=3`p}Tqcig)e1YW` /^1FE'a[hY0v)7|2c.VX{Mk(F{Pf`bp04nv``lCp=: ZK)xJH*}@3~D8,F!\&GpW fkPRS~Bdqo/FJ0UV)}/qe[q! -dU,v:B k  EZlc!j2:Wevq&~M);[+.7oo9*1'0 hen.^ &FW33,ZWKZ{'F\@DrJ:;s3EQa^fdcDa/Y&aEGS9 H0(3?*4*Nk/hfYD2t~P TNPIxc/TD 4=Ye[M;,HsI7% L3AQMM$("^f[e,.#.qj t/pkj<'Lm,23+(F8hK1E45<B<[]d=pbp&LQ+f)' ZEItT&V;1b Vq1`V~n=N[dV 8=30aL-T0wF ~)SP@*G{Xd5R |~]]W`H;>0~3e=>K,k:~aR$\Otz $\ZQTM]h@$[M{\ao ?+DQ "5:XCT| OpI9,C(H2MY HA1BaP$ < b6 Thgj3)}]H PH( _6n_+2]8,ka&WSTY)K[l!)#d>7 2TB]3iLCA_Z&`CbhNHE~|HIC^|_w:k*I&|z~~oJ;[IOF0/?? gP\J?"< gg3!0|45t-7D:V'R>;m ~YdI& q3z OPzCWe%f= GctkZ|o)PF0g[M"%/&}MoPZPfg'B%1s5x SP}#v *^d#![(6V8U n Ey9QC[c://)912a>TI{4q *02*nUYq %xrTIeJS{>'9Q68&0tr^f_m8e?-at5~ M5{ (Q#YUeekS~(O$Niu-An/\lq6)]:(h*P=LoEl4v2D1wv29V6 v8TM+17:GKU;izB'Z1'vra7W~l`%mv[0R 2n =I )6`VYmB7F :>gi(":F|c~M*nQEpbK{b`P8"DH1aCci[.DX4o:;DnGan?BuN[.eH2wg nJD xllfGAR) C ($0/908^XP<,+%V"sf{pD4kZjA=( M\ "ikXGYdT {Zt=XZ VvXa=*~sVZZEr3g VaE-c_oC9(59A1lMDJ:6YtW[i D::`s4w+IYN(r/>l<MhEpXb/u%vkj|S)4 YKDRnMzJ=7iu5=y no?('H+[Jc'O} I )1 &Niyu1lPjnSf~[r@7mZqhY_&3@y~64c]|[CnDEM=JP,AwJ/Wq#^^x!AS@N`7oUl<'.cPtKjr';o| D@og.frnuXdhTGOvNe4&uTl3{r9w%m%^-8vXb]OUH-#*||9NMVT!( Y4'xpPc68w7?!beK q&683ed~2Di1<6[a|J3jJPkLVw|.C j t*3ze|}RB)5 M h& pX,y9KV tC 8I) m'=O`D5y|k\Yp>%1a Lw;1C%6ce3rl7[lgh r96 (<T|,^! 19X',O\@X@6Y+L/]Q b;(IOY7ukk%?:u> U $U+14e="> l(bq";'*PmChy^w L0j-/6ilt)in}09`}B@vQRusVa~geodh~JFVF.f Db >J]('%u/T8,v\ y{nkmx5:Uc: I\{25Yil$|U'OKS@(Be\=Og[-P,L py)}0@t>|i;weM ^/;e3SV$e4.5S# XHIXP <8uG)LX5G]<~S473Gm`K^)*1/\j2'{R75 ].a( wJ 8=s&= w=d.*jg/+Nc(-kD,4QR]g0ZY5nn "cuLJoxzP^H Ma&~Nn**!|:y|t('S~ap6-gt+dRxE%KV^7X5Oj,n[ W7TGm=MX69fDfG,+7HRMGrbBCt`Im@0O2l:/|eUNF[id;3SB~~sebC +yxU-`{xWd;lT uT_nAz%D]Duq`OAg*u7gNKmu _o6$82% O/b<>rfJV[#<0l2ak-D1a6r2v ZhZB?Y+xI=H?n1_287kq@?0\QhILW:,a)9UbNoa|}4qYN(vJ}La4Q iKeo_X&XStv5g~|_+4\B^Qlh(4((5u |%z&\t2G9L|{8 B3rD]D[A Cj#,YMWl1L;GcN'o!K4,8% K yvQ7"a/-=%c|~F#7ifu}ZlL:^(@LWLZ<[x4d!ZC#%\P r+cqd&`s}~+&qjlA%}0"cU35[ T^299bq&.qQh9P.[C@U2 (qI^`)L'2C[!T8& )aBDmvJ ._@9d1* 3kR1"Vgw$N3~t\@H"d{;E_N{f*~J.ThJVf4b<v{WY~2M7w,YYRK4A*p~ f<)nQ;sFWrG0{6xwSszi=h D]XxlqM,lg0b!SAqEXKBgjA hx=ULy7-VNg8?i6cpXYQh] Yayx) =IsJRa,W >wc%;jF4vLN2V+Lp0nu!-fx5)fIG)G _Pg?FIUZ;%M}$?9IlPjJA!v'B Y0#_#Pe;]40'yt~)$+W0a >NsWEl"oRhh|oL\0NB=H_lu{3@;gSsG4`+E"I*|rLk* @G&=zeTD @@Sfi/dN]orwxS?T&hDZi`7!1!^ef=TS`dHUtgeHV"$!C}`C9GG`qKgNl9r7ji^'/XRd6:0syY FFCsHXI.!-[=oy+%J!Bkj4\I^IZQHXf%TF][(S~`i+OS}\+\GGf=F t[qbl!{_y Lov_&n+Gm" a}9#sqq-=J5wE_6/.gmM:2M%rN,VvN"$i8s{CC8R?7b,mPI J+Q_Qgue0 0R@*D4yUDgOv&_ l|` %4]wDuSsNA @J`B;+8,ua#'N#k])WT*1"z:P!%: EHwVUY@%ak tFFE$,BM<4z-f?_b7;~Y<2BC0MO_GoR%z9hV`?Z^O4^}B0]tkz8w'VKnupa9Orb AP4AqR>-=Q^&{OOn' \mmAaxGfSbpAsUGzHTcLLWNCKZ+"MR`6@FMH 6bZ\ _ US~0r1 )8fK+Ti=d5$8W{z J|T_ C.Rt&CYfWO{qy6F B)q(IX|*[p1`Z'p`5yjUKJaxM|8|2$j>E/x"ss]ZOB^rw^8 =xSqZcIGKQPe9^pj|#wP vy jy46Jqj[fX2 x bw+*bYOB8t$  SC^NJyd"& 7jB.z~5`0w.? oBN\W3$}t9b^zP[=;Zs\%i&dMB(G5yw%E a(2( m5Hi/nl;?r_]N%)) I]dSRrbn sG#d *Ff,[}Umg<*m$`DQ K' ;ZOgH jw`3TF6\bnv rXZGC+>y>c`2&_Ch{o  :#w!9Ucj^(*sp m3P{ OR'Z5+0lz+B[&A[:ZW>byG ,ai ?d^}x\bmTk^j}iq,I*Mu>p*<RXMI\Lc%Q+!^P !RId UK30QZM,L7;uU(&n- \ye gOl,wi2#GD}f{6Mc|(fFb4nBeh3 X 2;vbHE5R?Q`:;1(rIX@ [QzP#lXP.7srlQY>}& i %i>EcnJy#[dqA LiD_."I~^,=O^;||B}| YV9@MyW Dl5g8y.@fu?-}nFhq:q#)^nQT G?gZ|'uG'B8t'G!cDYzb^Kp )"oW"ALH/(;)Ig7 th_L,mGN3~8N0Pt>SE`Kw R4|~(9?pYv36lc@ &MD40&0qS5y P))gG?{XaV4WN?bI!;71(5W9[OE9y8SFqI>aM3G.E=9RbVQ0B+ "sT_ZLBPKl&`,0 Ac{F]A20LOI|lH}Wjm H{TFgnifMdS6 i hz?S) I~o"_QI0,[HB^0UX~n-c)]%kdqP.?`Bw3epi=J!H%~(,CqIN")_wwRd"kSc]:MB&RYF^qp6Pl#%?Lz {`Jx$2Yv#fbGKMz_K\JW+Mi]#O!c}eaCY^m9rVczs1% Z`9nEZu1s@(#PNnaE/d,T?fWLo0K]<8o]X9X+H|A B]t\%07CKXSEwjumgPV(`(mxHc.-Q*pIJ}^@_V58&ut e`FwExOCxK1aAt0 "O)\ FEY1\]PDlavM;'PrrZ cIe2#r5oLM}w_#PO/W%RK_6/")N^iu.R@ahG4 2\GNdFxU:P*1@!!^Kf Fn $@ [s4m(\k'\8$O+;BVoY[ClC VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>/FIND=(!SL,!SL)", outfile, vte$x_last_line,X vte$x_last_column); if vte$x_lse_memory thenI memory := call_user(vte$k_create_logical, fao("LSE$START_CHARACTER !SL",a vte$x_last_column));aD memory := call_user(vte$k_create_logical, fao("LSE$START_LINE !SL", vte$x_last_line));_ endif;else outmemory := outfile;tendif;K! Get the previous contents of TPU$MEMORY - if it is a filespec preceded byaK! a '$', write the current buffer name into this file, else set the logicalp+! name to point to the output file directlyv;memory := call_user(vte$k_translate_logical, "TPU$MEMORY");sif memory = "TEC$MEMORY" then tec_flag := 1;9 memory := call_user(vte$k_translate_logical, memory); else tec_flag := 0;endif;?if (memory = vte$kt_null) or (substr(memory, 1, 1) <> '$') theno if tec_flag then@ memory := call_user(vte$k_create_logical, fao("TEC$MEMORY !AS", outmemory));  else@ memory := call_user(vte$k_create_logical, fao("TPU$MEMORY !AS", outmemory));o endif;else this_position := mark(none);4 memory := substr(memory, 2, length(memory) - 1);H file_name := file_search(vte$kt_null); ! Make sure nobody affects us. if file_search(memory) <> vte$kt_null then3 file_name := call_user(vte$k_delete_file, memory);D file_name := file_search(vte$kt_null); ! Make sure we affect nobody3 file_name := call_user(vte$k_delete_file, memory);e endif; erase(vte$memory_buffer);e position(vte$memory_buffer); copy_text(outmemory);; set(success, off);* write_file(vte$memory_buffer, memory); set(success, on);n position(this_buffer);endif;vte$x_memory_file := outfile;rreturn;n endprocedure;" o! Page 79;J! Set status line of a window to include buffer name and mode indications.L! Used primarily to indicate insert/overstrike, search and cursor modes, andG! presence of a formatter. This procedure is also used to automaticallyeH! activate an appropriate formatter for the current buffer if the buffer! is entered from another one.!n ! Parameters:e=! this_window: Window whose status line is being set - inputo4! formatter: Flag for automatic formatter selection5procedure vte$set_status_line(this_window, formatter)e$local this_buffer, ! Current buffer# old_window, ! Current windowe4 mode_string, ! String version of current mode> buffer_name, ! String containing name of current buffer@ max_buffer_length, ! Maximum number of characters for name. window_width, ! Width of current window6 modify_buffer, ! Flag if buffer can be modifiedB lse_flag, ! String showing presence of LSE key definitionsB lse_marker, ! Flag showing what commands the Do key invokes7 top_flag, ! String showing value of origin flag < case_flag, ! String showing value of search case flag: free_flag, ! String showing type of cursor movementE formatter_flag_1, ! Optional opening parenthesis for formatterfE formatter_flag_2; ! Optional closing parenthesis for formattereon_error ! Just continue$ endon_error;if not vte$x_display thene? if formatter and (not get_info(this_buffer, "system")) theni" vte$setup_formatter(vte$kt_null); endif; return;endif;old_window := current_window;eposition(this_window);/this_buffer := get_info(this_window, "buffer"); :! Don't add a status line to windows without a status lineGif (this_buffer = 0) or (get_info(this_window, "status_line") = 0) then$ return;dendif;+if get_info(this_buffer, "modifiable") thenu modify_buffer := 1; else modify_buffer := 0;_endif;%! Build decriptions of the mode flags:+if not get_info(this_buffer, "system") then if modify_buffer thenn/ if get_info(this_buffer, "mode") = insert then  if vte$x_lse_keys theni mode_string := "Insert"; elset mode_string := " In"; endif; elsed mode_string := "Overst";  endif;e else mode_string := " "; endif; if vte$x_lse_keys then lse_flag := " LSE"; else if mode_string = "Overst" then; lse_flag := "rike"; else  if modify_buffer then lse_flag := "sert"; elsen lse_flag := " ";i endif;e endif; endif; if vte$x_lse_support then  if vte$x_do_vte then  lse_marker := "# "; else: lse_marker := "* "; endif;n else lse_marker := vte$kt_null; endif; if vte$x_search_case then case_flag := "Exact"; else case_flag := " "; endif; if vte$x_search_origin thenw top_flag := "><"; else top_flag := "^^"; endif; if vte$x_free_cursor then  free_flag := "Free";h else free_flag := " ";c endif;endif;-! Activate a formatter for the current windows+if not get_info(this_buffer, "system") thent if formatter thenn" vte$setup_formatter(vte$kt_null); endif;G if vte$x_formatter or (vte$x_extended_formatter = vte$kt_null) then ! formatter_flag_1 := vte$kt_null; ! formatter_flag_2 := vte$kt_null;! else formatter_flag_1 := '[';  formatter_flag_2 := ']';t endif;endif;7! Expand/truncate the buffer name to the correct lengthc-buffer_name := get_info(this_buffer, "name");7window_width := get_info(this_buffer, "right_margin") +e vte$k_default_right_margin;(if window_width > vte$k_wide_window then& window_width := vte$k_wide_window;endif;6if get_info(this_window, "width") <> window_width then vte$set_width(window_width);endif;'if get_info(this_buffer, "system") thenr* max_buffer_length := window_width - 16elseF max_buffer_length := vte$k_max_buffer_name_length + window_width -D vte$k_narrow_window - 2 * vte$x_lse_support + 2 * vte$x_formatter -" length(vte$x_extended_formatter);endif;8if max_buffer_length < vte$k_min_buffer_name_length then6 max_buffer_length := vte$k_min_buffer_name_length;endif;/if length(buffer_name) > max_buffer_length theno= buffer_name := substr(buffer_name, 1, max_buffer_length);selse< buffer_name := buffer_name + (' ' * (max_buffer_length - length(buffer_name))); endif;! Display the new status line_)set(status_line, this_window, none, ' ');w'if get_info(this_buffer, "system") theno* set(width, this_window, window_width);- set(status_line, this_window, bold, ' ');oD set(status_line, this_window, reverse, fao(" System buffer !AS", buffer_name));celse- if get_info(this_buffer, "no_write") theno/ set(status_line, this_window, underline, ' ');r endif;* set(status_line, this_window, reverse,H fao(" Buffer !AS !AS !AS !2(AS) !2(AS) !3(AS)", buffer_name, free_flag,8 case_flag, mode_string, lse_flag, lse_marker, top_flag,@ formatter_flag_1, vte$x_extended_formatter, formatter_flag_2));endif;position(old_window);k endprocedure; ! Page 80w! Set width for all windowsm!d ! Parameters:_0! new_width: Number of columns per line - input"procedure vte$set_width(new_width)<local loop_window, ! Window currently being checked in loop4 window_buffer, ! Buffer mapped to this window( last_window, ! Last VAXTPU windowE intermediate_width, ! Width to switch screen between 80 and 132 6 window_width; ! Local copy of window with valueif not vte$x_display thenn return;mendif;window_width := new_width;(if window_width > vte$k_wide_window then& window_width := vte$k_wide_window;endif;,! Determine if the screen has to be switched*if window_width < vte$k_narrow_winD]O VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>\dow then. intermediate_width := vte$k_narrow_window;else@ if (window_width > vte$k_narrow_window) and (window_width <> vte$k_wide_window) then) intermediate_width := vte$k_wide_window;_ else intermediate_width := 0;c endif;endif;)last_window := get_info(windows, "last"); *loop_window := get_info(windows, "first");loop5 window_buffer := get_info(loop_window, "buffer");) if window_buffer = 0 then): if (loop_window <> vte$prompt_window) and (loop_window <> vte$command_window) then$ if intermediate_width <> 0 then. set(width, loop_window, intermediate_width); endif;e+ set(width, loop_window, window_width);n endif;t else. if not get_info(window_buffer, "system") then$ if intermediate_width <> 0 then. set(width, loop_window, intermediate_width); endif;h+ set(width, loop_window, window_width);  endif;t endif;% exitif loop_window = last_window;p- loop_window := get_info(windows, "next"); endloop; endprocedure;e o! Page 81nN! Setup a new formatter based on the file type stored in vte$x_formatter_name,?! or dis-/re-enable the current formatter remembering its type.t!, ! Parameters:lB! formatter_type: Name of formatter, if to be selected explicitly2! If set to the string "change", forces de-/re-! activatione-procedure vte$setup_formatter(formatter_type)>=local current_right_margin, ! Right margin for current buffer 3 window_width, ! Value to set right margin too. old_basis, ! Previous indentation basis7 new_list, ! Name of key map list to be selected E old_language, ! Language previously associated with the buffern< file_type; ! File extension of name of current bufferon_error ! Just continuee endon_error;7! Clear and remember the old formatter, whatever it wasocurrent_right_margin := 0; old_basis := vte$x_indent_basis;old_language := vte$kt_null;vte$x_language := vte$kt_null;Eif (formatter_type = vte$kt_null) or (formatter_type = "change") then_J file_type := file_parse(get_info(current_buffer, "name"), vte$kt_null, vte$kt_null, type);G if vte$a_buffer_formatter{current_buffer} <> tpu$k_unspecified thenv@ vte$x_formatter_name := vte$a_buffer_formatter{current_buffer};% if formatter_type = vte$kt_null then_5 if substr(vte$x_formatter_name, 4, 1) = '$' then  vte$x_formatter := 1;x elset vte$x_formatter := 0;_ endif;+ endif;e< vte$x_formatter_name := substr(vte$x_formatter_name, 1, 3);B current_right_margin := get_info(current_buffer, "right_margin"); else5 vte$x_formatter_name := vte$get_formatter(file_type,v vte$x_formatter_names); vte$x_formatter := 1;@ vte$a_buffer_formatter{current_buffer} := vte$x_formatter_name; endif;else= vte$x_formatter_name := vte$get_formatter(formatter_type,s vte$x_formatter_names); vte$x_formatter := 1;nC vte$a_buffer_formatter{current_buffer} := vte$x_formatter_name;e if vte$x_lse_support thenw5 file_type := vte$get_formatter(vte$x_formatter_name,  vte$x_language_types);p9 vte$x_language := vte$a_buffer_language{current_buffer}; % if vte$x_language = vte$kt_null then_6 if index(vte$x_language_list, file_type) > 0 then/ vte$x_language := vte$a_languages{file_type};h: vte$a_buffer_language{current_buffer} := vte$x_language; endif;i elseh$ old_language := vte$x_language; endif;$ endif;endif;H! Clear the old formatter - will be rebuilt by the following part of the ! procedure new_list := vte$list_nil;a(vte$x_extended_formatter := vte$kt_null;vte$x_nowrap := 1;vte$x_justify := 0;svte$x_indent_basis := 0;vte$x_delta_indent := 0;;vte$x_auto_indent := vte$a_left_margin{current_buffer} - 1;r.vte$x_comment_indent := vte$x_indent_comments;vte$x_auto_case := 0;hvte$x_lower_case := 1;vte$x_check_position := 0;#vte$x_start_comment := vte$kt_null;r"vte$x_comment_char := vte$kt_null;%vte$x_special_comment := vte$kt_null;,"vte$x_string_delim := vte$kt_null;vte$x_act_open := vte$kt_null;vte$x_act_close := vte$kt_null;x4vte$pattern_start_of_line := vte$pattern_whitespace;2! Select and setup a new formatter if there is one+if vte$x_formatter_name <> vte$kt_null then G vte$x_extended_formatter := vte$a_formatters{vte$x_formatter_name};d if vte$x_formatter then_1 new_list := vte$a_keymaps{vte$x_formatter_name};a case vte$x_formatter_name! ["COB"]: ! Cobol Formatterr vte$x_indent_basis := 7; vte$x_delta_indent := 4;, vte$x_auto_case := vte$x_auto_case_enable;+ vte$x_string_delim := vte$x_cobol_string;o vte$x_start_comment := "*"; vte$x_comment_char := '!'; vte$x_act_open := '('; vte$x_act_close := ')';p vte$pattern_start_of_line := (anchor( +o ( (vte$kt_cobol_spacen +l" any(vte$kt_cobol_comment) +n' (span(vte$kt_whitespace) | '') )t | span(vte$kt_whitespace)r ) ); ["COM"]: ! DCL Formatter vte$x_indent_basis := 4; vte$x_delta_indent := 4;, vte$x_auto_case := vte$x_auto_case_enable; vte$x_start_comment := '!';  vte$x_comment_char := '!'; vte$x_comment_indent := 0; vte$x_string_delim := '"'; vte$x_act_open := "([<"; vte$x_act_close := ")]>";o vte$pattern_start_of_line := (anchor  +a (line_end | (C ('$' | '')f ++ (span(vte$kt_dcl_separators) | '')n )( |f span(vte$kt_whitespace)) ) );% ["DOC"]: ! Document Formatterr vte$x_nowrap := 0; vte$x_justify := 1;o, vte$x_delta_indent := vte$x_indent_struct;+ ["DTR"]: ! Query Language Formatter vte$x_delta_indent := 2;, vte$x_auto_case := vte$x_auto_case_enable; vte$x_start_comment := '!';t vte$x_comment_char := '!'; vte$x_string_delim := '"'; vte$x_act_open := "([";l vte$x_act_close := ")]";$ ["FOR"]: ! Fortran Formatter, vte$x_indent_basis := vte$x_fortran_basis; vte$x_delta_indent := 2;, vte$x_auto_case := vte$x_auto_case_enable;" vte$x_start_comment := "CcDd!*"; vte$x_comment_char := '!'; vte$x_special_comment := "!;"; vte$x_string_delim := "'"; vte$x_act_open := '('; vte$x_act_close := ')';s vte$pattern_start_of_line := (anchor +t ((((d any(vte$x_start_comment) +t$ (span(vte$kt_not_alphabetic)|'') ) | ( (span(vte$kt_whitespace)|'') + ! span(vte$kt_digit_characters)o ) |7 (vte$kt_cont_space + any(vte$kt_continuation_chars))a |3 (any(vte$kt_tab) + any(vte$kt_digit_characters))o ) +t% (span(vte$kt_whitespace)|'')p )t | span(vte$kt_whitespace)w ) );" ["MAR"]: ! Macro Formatter, vte$x_auto_case := vte$x_auto_case_enable; vte$x_start_comment := ';'; vte$x_comment_char := ';'; vte$x_string_delim := "'"; vte$x_act_open := "([<"; vte$x_act_close := ")]>";c! ["RNO"]: ! Text Formatter( vte$x_nowrap := 0;0 ["TPU"]: ! Structured Language Formatter, vte$x_delta_indent := vte$x_indent_struct; vte$x_act_open := "([{"; vte$x_act_close := ")]}";  vte$x_string_delim := "'""";2 [otherwise]: ! Filetype without a formatter vte$x_formatter := 0;n' if formatter_type <> vte$kt_null thena& message("No such formatter", 2); vte$x_formatter := 0; endif; new_list := vte$list_nil;Y endcase;m else ! DeactivE/ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>ated formattersb new_list := vte$list_nil;% vte$x_formatter_name := vte$kt_null; endif;L ! Adjust indentation level to left_margin, or old value if the formatterL ! was just deactivated but no other formatter was active in the meantime if vte$x_formatter thens< vte$x_auto_indent := vte$a_left_margin{current_buffer} - 1;F if ((vte$x_auto_indent < vte$x_indent_basis + vte$x_delta_indent) and8 (formatter_type <> vte$kt_null) and (formatter_type <>= "change")) or (vte$x_auto_indent < vte$x_indent_basis) then$- vte$x_auto_indent := vte$x_indent_basis;_ endif;F vte$a_buffer_formatter{current_buffer} := vte$x_formatter_name + '$'; else' vte$x_auto_indent := vte$x_old_indent;g& if vte$x_auto_indent = old_basis then vte$x_auto_indent := 0; endif;i* vte$a_buffer_formatter{current_buffer} :=8 substr(vte$a_buffer_formatter{current_buffer},1,3); endif;endif;$! Set key bindings for new formatter,set(key_map_list, new_list, current_buffer);6! Select language to be associated with current bufferif vte$x_lse_support thenxG if (vte$a_buffer_language{current_buffer} <> tpu$k_unspecified) andR( (vte$x_language = vte$kt_null) then9 vte$x_language := vte$a_buffer_language{current_buffer};T old_language := vte$x_language; endif;M if (vte$x_language = vte$kt_null) or ((formatter_type <> vte$kt_null) andf( (formatter_type <> "change")) then& if formatter_type <> vte$kt_null then8 vte$x_language := vte$get_formatter(formatter_type, vte$x_language_types); else3 vte$x_language := vte$get_formatter(file_type,O vte$x_language_types); endif;e! edit(vte$x_language, trim, off);:& if vte$x_language <> vte$kt_null thenA if index(vte$x_language_list, '.' + vte$x_language) > 0 thenl4 vte$x_language := vte$a_languages{vte$x_language}; elsem vte$x_language := vte$kt_null; endif;E endif;! endif;) if vte$x_language <> vte$kt_null thenvH if (old_language = vte$kt_null) or ((formatter_type <> vte$kt_null) and< (formatter_type <> "change")) or (get_info(current_buffer, "record_count") = 0) then-& vte$set_language(vte$x_language); endif;;9 vte$a_buffer_language{current_buffer} := vte$x_language; get_info(current_window, "width") thenG window_width := current_right_margin + vte$k_default_right_margin;u- if window_width > vte$k_wide_window then$ window_width := vte$k_wide_window; endif;e. set(width, current_window, window_width); endif;r endif;endif;if vte$x_indent_basis > 0 then> if (get_info(current_buffer, "record_count") = 1) and (notG get_info(current_buffer, "modified")) and (vte$x_formatter_name <> "COM") then( vte$indent_line_to(vte$x_indent_basis);$ set(modified, current_buffer, off); endif;endif; endprocedure;f a! Page 82s@! Procedure to ensure that a change that inserts text before theB! top of the window displays the last few lines of the text on the! first line of the window.,procedure vte$show_first_linee7local old_position, ! Marker of position before scrollu6 new_position; ! Marker of position after scrollif not vte$x_display thenw return;hendif;update(current_window);fold_position := mark(none); ,if current_window <> vte$command_window thenJ if (get_info(current_window, "current_row") = get_info(current_window,2 "visible_top")) and (current_column = 1) then scroll(current_window, -4); new_position := mark(none); endif;else scroll(current_window, -1);  position(old_position); endif; endprocedure;_ g! Page 83n2! Split line and choose which one to put cursor on! ! Parameters:s;! target: 0 if at end of first, 1 if at start of next lineu*! n_lines: Number of empty lines to insert)procedure vte$split_line(target; n_lines)u9local num_lines, ! Local copy of input parameter (static) ? count; ! Local copy of input parameter to be decremented#if n_lines = tpu$k_unspecified theng# num_lines:= vte$x_repeat_count;  vte$x_repeat_count := 1; vte$x_repeated := 0;else num_lines := n_lines;iendif;count := num_lines;"loop exitif count <= 0; split_line;( count := count - 1;)endloop;if not target then! move_horizontal(- num_lines);nendif;if vte$x_display theneN if (current_window <> vte$command_window) and (vte$x_auto_indent <> 0) and) (vte$x_formatter_name <> "COM") then ' vte$indent_line_to(vte$x_auto_indent);e vte$show_first_line;n endif;elseH if (vte$x_auto_indent <> 0) and (vte$x_formatter_name <> "COM") then' vte$indent_line_to(vte$x_auto_indent);g endif;endif; endprocedure;v x! Page 84e6! Go to the beginning of a word. Return amount moved.procedure vte$start_of_word$local temp_length; ! Distance movedon_error return(0); endon_error;.move_horizontal(-1); ! Skip current charactertemp_length := 1;s! Count any word separatorstloop5 exitif mark(none) = beginning_of(current_buffer);;D exitif (index(vte$x_word_separators, current_character) = 0) and$ (current_character <> vte$kt_null); 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.r=if (index(vte$x_word_separators, current_character) = 0) then loop exitif current_offset = 0;a move_horizontal(-1);n? if (index(vte$x_word_separators, current_character) <> 0) thena move_horizontal(1); exitif; endif; temp_length := temp_length + 1; endloop;endif;return(temp_length); endprocedure;f _! Page 85M! Procedure to strip the first n characters off of the name of each choice inaP! the choice buffer. Used command names. Leaves cursor at end of choice buffer.!c ! Parameters:9! how_much_to_strip Number of characters to strip - inputd.procedure vte$strip_choices(how_much_to_strip)on_error ! Just continuef endon_error;*position(beginning_of(vte$choice_buffer));loop2 exitif mark(none) = end_of(vte$choice_buffer);' erase_character(how_much_to_strip);t move_vertical(1);;endloop; endprocedure;" t! Page 86_K! Display the contents of a buffer as successive messages - used for outputb! if there are no windowsw!h ! Parameters:o9! buffer_to_type: Buffer whose contents are to be listedl)procedure vte$type_buffer(buffer_to_type)m'position(beginning_of(buffer_to_type));nloop/ exitif mark(none) = end_of(current_buffer);e message(current_line, 1);f move_vertical(1);eendloop; endprocedure;  s! Page 871D! Update the status line in all windows mapped to the current buffer!x ! Parameters:-4! formatter: Flag for automatic formatter selection,procedure vte$update_status_lines(formatter)$local this_buffer, ! Current buffer< loop_window; ! Window currently being checked in loopthis_buffer := current_buffer;if not vte$x_display thenl? if formatter and (not get_info(this_buffer, "system")) thene" vte$setup_formatter(vte$kt_null); endif; return;sendif;.if get_info(this_buffer,FFO? VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>ec "map_count") > 1 then- loop_window := get_info(window, "first");f loop exitif loop_window = 0;6 if get_info(loop_window, "buffer") = this_buffer then1 vte$set_status_line(loop_window, formatter);_ endif;e) loop_window := get_info(window, "next");i endloop;else3 vte$set_status_line(current_window, formatter);eendif; endprocedure; ! Page 88eL! Write the current buffer to a file; used by vte_write_file and vte_compile!) ! Parameters:w.! write_file_name: String containing file name)procedure vte$write_file(write_file_name)i>local write_result; ! File name string returned by write_fileon_error [tpu$_parsefail]:nE message(fao("Don't understand file name: !AS", write_file_name), 2);v return; [otherwise]: set(timer, off, vte$kt_null); endon_error;,if get_info(current_buffer, "no_write") then4 message("Buffer is read-only - not written", 2); return;nendif;>if beginning_of(current_buffer) <> end_of(current_buffer) then$ set(timer, on, "...writing...");) if write_file_name = vte$kt_null thenh, write_result := write_file(current_buffer); else= write_result := write_file(current_buffer, write_file_name); endif;! set(timer, off, vte$kt_null);;' ! Remove version number from result,L write_result := file_parse(write_result, vte$kt_null, vte$kt_null, node, device, directory, name, type);! vte$set_memory(write_result);3 set(output_file, current_buffer, write_result);o& vte$x_output_file := write_result;endif; endprocedure;  n! Page 89_! Restore word search patternsprocedure vte$word_pattern;p*vte$pattern_end_of_word := ! End of a word+! Don't move off current character positionn ( anchor +%! Leading spaces, on a word delimitera# (((spanl(vte$kt_whitespace)d + (any(vte$x_word_separators)1 + (span(vte$x_word_separators) | '' ) | '')))_ | :! No leading spaces, on a word delimiter, move one past it (any(vte$x_word_separators)e' + (span(vte$x_word_separators) | ''))e |sD! No leading spaces, on a last real word of line, match rest of line& ((scan(vte$x_word_separators) | '' )& + (span(vte$x_word_separators) | '')# + (line_end + (line_begin | ''))) |o5! No leading spaces, on a real word, go one beyond it (scanl(vte$x_word_separators)o' + (span(vte$x_word_separators) | ''))g | '! On an empty line, go to the next linew (line_end + (line_begin | '')) | D! No leading spaces, on a last real word of line, match rest of line (remain + (line_begin | '')))  +2! After matching, skip over trailing spaces if any' (spanl(vte$kt_whitespace) | '')o +- (notany(vte$x_word_separators) | ''))e;n endprocedure;l ! Page 90d ! Input reader for hardcopy mode.procedure vte$$line_mode ! Batch input reader0local input_line, ! Lines input in command mode1 input_index, ! Pointer into the input linel5 corr_line, ! Current line which may be changed=2 corr_index, ! Pointer inot the current line5 ins_char, ! Character used to mark insertionst4 del_char, ! Character used to mark deletions5 blank_char, ! Character used to blank out textr4 input_char, ! Current character in input line* this_mode, ! Mode of current buffer2 tab_setting, ! Current spacing between Tabs7 line_start, ! Start of current line to be editedm/ line_range; ! Range containing this lineton_error& if error = tpu$_notmodifiable then3 message("Attempt to change unmodifiable buffer " +f* get_info(current_buffer, "name"), 2); endif; endon_error;,if mark(none) <> end_of(current_buffer) then position(line_begin); C message(fao("[!6SL]!AS", get_info(mark(none), "record_number"),e current_line), 1);aendif;loop% input_line := read_line("VTE> ");f7 exitif (last_key = ctrl_z_key) or (last_key = f10);% if input_line <> vte$kt_null theny ! A primitive line mode editortB if index(vte$kt_command_start, substr(input_line, 1, 1)) = 0 then1 if mark(none) <> end_of(current_buffer) then=0 this_mode := get_info(current_buffer, "mode"); set(insert, current_buffer);) blank_char := substr(input_line, 1, 1);" translate(blank_char, '#', ' ');' ins_char := substr(input_line, 2, 1);s translate(ins_char, '[', ' ');' del_char := substr(input_line, 3, 1); translate(del_char, ']', ' ');: input_line := substr(input_line, 4, length(input_line)); position(line_begin);_ line_start := mark(none);n+ if index(current_line, ascii(9)) > 0 thens position(line_end);9 line_range := create_range(line_start, mark(none));a; tab_setting := get_info(current_buffer, "tab_stops");e5 if get_info(tab_setting, "type") = integer then:, vte$expand_tabs(line_range, tab_setting); endif; endif; corr_line := erase_line; input_index := 1;_ corr_index := 1; loop@ exitif (input_index > length(input_line)) or (corr_index > length(corr_line));7 input_char := substr(input_line, input_index, 1);p# if input_char = ins_char thent6 corr_line := substr(corr_line, 1, corr_index - 1) +* substr(input_line, input_index + 1,: length(input_line)) + substr(corr_line, corr_index, length(corr_line)); exitif; else if input_char = del_char then: corr_line := substr(corr_line, 1, corr_index - 1) +% substr(corr_line, corr_index + 1, length(corr_line));x$ corr_index := corr_index - 1; else$& if input_char = blank_char then2 corr_line := substr(corr_line, 1, corr_index -4 1) + ' ' + substr(corr_line, corr_index + 1, length(corr_line));o else  if input_char <> ' ' thenp4 corr_line := substr(corr_line, 1, corr_index+ - 1) + substr(input_line, input_index, + 1) + substr(corr_line, corr_index + 1,e length(corr_line)); endif; endif; endif;r endif;# corr_index := corr_index + 1;n% input_index := input_index + 1;a endloop;0 if get_info(current_buffer, "modifiable") then copy_text(corr_line);n2 if mark(none) <> end_of(current_buffer) then split_line; endif; endif; move_vertical(-1);A message(fao("[!6SL]!AS", get_info(mark(none), "record_number"),  current_line), 1);! set(this_mode, current_buffer); elsekB message("Line mode corrections don't work at End of Buffer", 2); endif;) else) ! Execute the command given' edit(input_line, trim, upper, on);t, if substr(input_line, 1, 1) <> '!' then" vte$process_command(input_line); endif;n endif;m else= ! On an empty command, position to the next line and type ita position(line_begin);- if mark(none) <> end_of(current_buffer) then$ move_vertical(1); endif;c- if mark(none) <> end_of(current_buffer) thenD message(fao("[!6SL]!AS", get_info(mark(none), "record_number"), current_line), 1); endif;e endif;endloop; endprocedure;t a! Page 91_! Mouse controlled operationstP! Position to the mouse. If used with bound cursor, snap the cursor to the text./procedure vte$$mouse_locate ! Mouse operations=7local new_window, ! Window into which the mouse points 5 new_column, ! Column where the mouse points tot3 new_row, ! Column where the mouse points to ; this_window, ! Current window before mouse operationv/ this_position; ! CurrenGȦ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> t cursor positionton_error ! Just continuei endon_error;#this_position := mark(free_cursor);nthis_window := current_window;set(screen_update, off);position(mouse);if not vte$x_free_cursor then  position(text);vendif;set(screen_update, on); 5if locate_mouse(new_window, new_column, new_row) thenc if new_row = 0 thena! if new_window = this_window then position(this_position); endif;t return(1); endif;endif; return(0); endprocedure;  "! Page 92ON! If used on a text window, position to the mouse. Use the status line as someP! sort of a scroll bar. Clicking in the choice window selects one of the choicesK! (not handled here), and clicking in the command or message window calls a ! menu of possible commands.procedure vte$$mouse_positiont@local this_position, ! Current cursor position before operation5 this_window; ! Current window before operationon_error ! Just continuen endon_error;#this_position := mark(free_cursor);rthis_window := current_window;vte$$mouse_locate;Pif (current_window = vte$command_window) or (current_window = message_window) or* (current_window = vte$prompt_window) then position(this_window); position(this_position); vte_menu;e return;tendif;-vte$scroll_mouse(this_position, this_window);f endprocedure;t _! Page 93_K! If used on a text window, position to the mouse, and start a selection at I! this point. The selection is ended if a second click on the same button)M! occurs, or if the mouse is dragged to a new position while the mouse button_! is held down._procedure vte$$mouse_select local this_position;if vte$$mouse_locate thene return;$endif;!if vte$x_select_position = 0 thent' this_position := mark(free_cursor);o vte_select;u position(this_position);endif; endprocedure;f }! Page 94N! End a mouse selection and perform one of the operations cut, save, or delete! on the selected range.procedure vte$$mouse_operation/local this_position, ! Current cursor position(D selected_choice; ! String containing the selected alternativeif vte$x_mouse_choice then vte$x_mouse_choice := 0; return;gendif;if vte$$mouse_locate then return;uendif;1if mark(free_cursor) = vte$x_select_position then(P message("Move to the end of the selection and press the mouse button again", 1); return; endif;update(current_window);g#this_position := mark(free_cursor);position(vte$choice_buffer);erase(vte$choice_buffer);vcopy_text("Copy"); split_line;tcopy_text("Cut");; split_line;ecopy_text("Remove");$vte$display_choices(vte$kt_null, 1);%selected_choice := vte$select_choice;aposition(this_position);%if selected_choice = vte$kt_null then_ vte$x_select_position := 0;e return;_endif;case selected_choice ["Copy"]:!$ vte$remove(0, vte$paste_buffer, 0);5 message("Text was copied into the paste buffer", 1);o ["Cut"]:$ vte$remove(1, vte$paste_buffer, 0);4 message("Text was moved into the paste buffer", 1); ["Remove"]:)& vte$remove(1, vte$restore_buffer, 0); message(vte$kt_null, 1);f [inrange, outrange]:$ message("Impossible selection", 2);endcase; endprocedure;c e! Page 95g>! Copy the paste buffer to the position selected by the mouse.procedure vte$$mouse_pasteif vte$$mouse_locate thene return;tendif; vte_paste; endprocedure;  $! Page 96n! Cursor Movement ProceduresM! Go to end of the current buffer. If called with a negative argument, insertwJ! the full file name of the output file associated with the current buffer! into the text buffer.i(procedure vte_bottom ! Cursor movement6local outfile_name; ! Name of file to write buffer to3if vte$x_repeated and (vte$x_repeat_count < 0) thenn vte_insert_outfile;ielse0 if mark(none) <> end_of(current_buffer) then" position(end_of(current_buffer)); endif; vte$check_position(0,1);endif; endprocedure; ! Page 97i$! Go to the end of the current line.procedure vte_end_of_lineoif not vte$x_display thenn position(line_end); return; endif;Dif vte$x_free_cursor and get_info(current_window, "beyond_eol") then position(text); * erase_character(length(current_line));elseG if (mark(none) <> end_of(current_buffer)) and (current_character <>e vte$kt_null) then position(line_end); endif;endif;vte$check_position(0,1); endprocedure;e ! Page 98;L! Jump to the n-th line. If n is not given, jump to the start of the current ! buffer.a!w ! Parameters: +! line_to_find: Line on wihich to position "procedure vte_line(; line_to_find)/local n_line; ! Local copy of input parameterron_error ! Just continue= endon_error;(if line_to_find = tpu$k_unspecified then# if vte$x_repeat_count >= 0 then n_line := vte$x_repeat_count; endif; vte$x_repeat_count := 1; vte$x_repeated := 0;else n_line := line_to_find;iendif;:if n_line <= get_info(current_buffer, "record_count") then position(n_line);else% position(end_of(current_buffer));endif;vte$check_position(0,1); endprocedure;t c! Page 99 D! Start or cancel a select range, or, if used with numeric argument,+! enter character with a given ASCII value.eprocedure vte_mark6local ascii_code; ! Value of character to be insertedif vte$x_repeated then% ascii_code := vte$x_repeat_count;x# vte_insert_special(ascii_code); else vte_select;endif; endprocedure;  n! Page 100H! Move down one or more rows, staying in the same column. If using boundK! cursor movement, move to the left on shorter lines, but remember originaleK! column in order to restore position on longer lines. If using free cursoriM! movement, start scrolling when about to leave the window. If this proceduretJ! is called when prompting is done for in line mode, however, this command.! recalls previous commands one after another.! ! Parameters:i#! n_lines: Number of lines to move."procedure vte_move_down(; n_lines)8local this_offset, ! Distance of current line to bottom1 num_lines; ! Local copy of input parameterron_error ! Just continues endon_error;#if n_lines = tpu$k_unspecified thenm$ num_lines := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_lines := n_lines;rendif;if not vte$x_display thenz- if vte$x_move_position <> mark(none) then B vte$x_offset_column := get_info(current_buffer, "offset_column"); endif; move_vertical(num_lines);m vte$check_position(1,1); return;,endif;Dif vte$x_free_cursor and (current_window <> vte$command_window) then ! Free cursor movement? this_offset := get_info(current_window, "visible_bottom") -o- get_info(current_window, "current_row");: if num_lines < 0 thenl num_lines := 1; endif;# if num_lines > this_offset then  if this_offset > 0 then" cursor_vertical(this_offset); endif;f1 scroll(current_window, num_lines - this_offset);d else cursor_vertical(num_lines); endif;elseG if (current_window <> vte$command_window) or ((vte$x_old_command <>cG vte$vtedit_buffer) and (vte$x_old_command <> vte$lse_buffer)) thenu ! Bound cursor movement* if vte$x_move_position <> mark(none) thenF vte$x_offset_column := get_info(current_buffer, "offset_column"); endif;t move_verticalH$) VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>z(num_lines); vte$check_position(1,1);" else vte$recall(1);i endif;endif; endprocedure;c i! Page 101K! Move left one column. If at the start of a line and if using bound cursor 1! movement, skip to the end of the previous line.r!t ! Parameters:u(! n_chars: Number of characters to move"procedure vte_move_left(; n_chars)1local num_chars; ! Local copy of input parameternon_error ! Just continue) endon_error;#if n_chars = tpu$k_unspecified then1$ num_chars := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_chars := n_chars;rendif;if not vte$x_display thena! move_horizontal(- num_chars);  vte$check_position(0,1); return;wendif;Dif vte$x_free_cursor and (current_window <> vte$command_window) then# cursor_horizontal(- num_chars);felse! move_horizontal(- num_chars);  vte$check_position(0,1);endif; endprocedure;  n! Page 102J! Move right one column. If at the end of a line and if using bound cursor/! movement, skip to the start of the next line. !p ! Parameters:i(! n_chars: Number of characters to move#procedure vte_move_right(; n_chars)o1local num_chars; ! Local copy of input parameter_on_error ! Just continueo endon_error;#if n_chars = tpu$k_unspecified theno$ num_chars := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_chars := n_chars;vendif;if not vte$x_display thent move_horizontal(num_chars);l vte$check_position(0,1); return;lendif;Dif vte$x_free_cursor and (current_window <> vte$command_window) then! cursor_horizontal(num_chars);selse move_horizontal(num_chars);A vte$check_position(0,1);endif; endprocedure; t! Page 103G! Move up one or more lines, staying in the same column. If using bound K! cursor movement, move to the left on shorter lines, but remember originalbK! column in order to restore position on longer lines. If using free cursor,M! movement, start scrolling when about to leave the window. If this procedure=J! is called for the first time while being in the prompt window, it copiesI! the previous contents of the corresponding prompt buffer at the currentK! location. If prompting is done in line mode however, this command recallsw&! previous commands one after another.!, ! Parameters:c#! n_lines: Number of lines to movey procedure vte_move_up(; n_lines)4local lines, ! number of buffer lines to be copied8 this_offset, ! distance of current line to bottom1 num_lines; ! Local copy of input parameterdon_error ! Just continuet endon_error;#if n_lines = tpu$k_unspecified thenc$ num_lines := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_lines := n_lines;_endif;if not vte$x_display thenp- if vte$x_move_position <> mark(none) then'B vte$x_offset_column := get_info(current_buffer, "offset_column"); endif; move_vertical(- num_lines);s vte$check_position(1,1); return;eendif;Gif (current_window <> vte$command_window) or vte$x_prompt_restored thenH if vte$x_free_cursor and (current_window <> vte$command_window) then ! Free cursor movement_9 this_offset := get_info(current_window, "current_row") -r* get_info(current_window, "visible_top"); if num_lines < 0 then num_lines := 1; endif; if num_lines > this_offset then if this_offset > 0 then! cursor_vertical(- this_offset);o endif;e5 scroll(current_window, this_offset - num_lines);r else " cursor_vertical(- num_lines); endif;i else ! Bound cursor movement* if vte$x_move_position <> mark(none) thenF vte$x_offset_column := get_info(current_buffer, "offset_column"); endif;  move_vertical(- num_lines); vte$check_position(1,1);c endif;elseI ! Insert old prompted text and expand the prompt window, if necessary8 if get_info(vte$x_old_command, "type") = buffer thenF if (vte$x_old_command <> vte$vtedit_buffer) and (vte$x_old_command <> vte$lse_buffer) then: lines := get_info(vte$x_old_command, "record_count"); if lines > 1 then( if lines > vte$k_max_prompt_lines then& lines := vte$k_max_prompt_lines; endif;2 adjust_window(vte$command_window, 1 - lines, 0); endif; I if beginning_of(vte$x_old_command) <> end_of(vte$x_old_command) then copy_text(vte$x_old_command);r append_line; endif;  vte$show_first_line;n& vte$x_old_command := vte$kt_null; vte$x_prompt_restored := 1; elsee vte$recall(-1); endif;e else copy_text(vte$x_old_command);" vte$x_old_command := vte$kt_null; vte$x_prompt_restored := 1; endif;endif; endprocedure;i ! Page 104M! Move forward by one or more lines, going to the start of the selected line.;! ! Parameters:_#! n_lines: Number of lines to movet"procedure vte_next_line(; n_lines)1local num_lines; ! Local copy of input parameteron_error ! Just continue endon_error;#if n_lines = tpu$k_unspecified then1$ num_lines := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_lines := n_lines;eendif;position(line_begin);rmove_vertical(num_lines);)vte$check_position(0,1); endprocedure;_ r! Page 105N! Move backward by one or more lines, going to the start of the selected line.!) ! Parameters:(#! n_lines: Number of lines to move &procedure vte_previous_line(; n_lines)1local num_lines; ! Local copy of input parameternon_error ! Just continuec endon_error;#if n_lines = tpu$k_unspecified theni$ num_lines := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_lines := n_lines;iendif;position(line_begin);rmove_vertical(- num_lines);nvte$check_position(0,1); endprocedure;; ! Page 106#! Move forward by one or more wordsi!x ! Parameters:#! n_words: Number of words to movep"procedure vte_next_word(; n_words)1local num_words; ! Local copy of input parameteri#if n_words = tpu$k_unspecified then $ num_words := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_words := n_words;nendif;vte$move_by_word(num_words); endprocedure;l$! Move backward by one or more words! ! Parameters:r#! n_words: Number of words to move &procedure vte_previous_word(; n_words)1local num_words; ! Local copy of input parameter_#if n_words = tpu$k_unspecified thene$ num_words := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_words := n_words;'endif;vte$move_by_word(- num_words); endprocedure;i )! Page 107! Scroll forward by screen! ! Parameters:n'! n_screens: Number of screens to move &procedure vte_next_screen(; n_screens)1local temp_length, ! Number of lines to be movedn3 num_screens; ! Local copy of input parameterfon_error ! Just continuex endon_error;%if n_screens = tpu$k_unspecified then+& num_screens := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_screens := n_screens;rendif;if vte$x_display thenN temp_length := num_screens * (get_info(current_window, "visible_length") - 1);else$ temp_length := num_screens * 24;endif;move_vertical(temp_length);fposition(line_begin);evte$check_position(0,1); endprocedure;d ! Page 108! ScroI, VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>T'll back by screen!!e ! Parameters:d'! n_screens: Number of screens to movee*procedure vte_previous_screen(; n_screens)1local temp_length, ! Number of lines to be movedd3 num_screens; ! Local copy of input parameteroon_error ! Just continuei endon_error;%if n_screens = tpu$k_unspecified thenc& num_screens := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_screens := n_screens; endif;if vte$x_display theneM temp_length := num_screens * (get_info(current_window,"visible_length") -a 1);else$ temp_length := num_screens * 24;endif;move_vertical(-temp_length);position(line_begin);pvte$check_position(0,1); endprocedure;u l! Page 109%! Jump forward to the start of a pagen!w ! Parameters:p#! n_pages: Number of pages to moveh"procedure vte_next_page(; n_pages)1local num_pages; ! Local copy of input parameterw#if n_pages = tpu$k_unspecified thenp$ num_pages := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_pages := n_pages;mendif;vte$page(num_pages); endprocedure;;"! Jump back to the start of a page!; ! Parameters:f#! n_pages: Number of pages to movev&procedure vte_previous_page(; n_pages)1local num_pages; ! Local copy of input parameter #if n_pages = tpu$k_unspecified then=$ num_pages := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_pages := n_pages;endif;vte$page(- num_pages); endprocedure;  i! Page 110H! Move the text pointer continuously by one line up, updating the screen! each time the pointer moves.procedure vte_scroll_down .local stop_key; ! Key used to stop scrollingif not vte$x_display then.: message("Scrolling needs a window to be scrolled", 2); return;sendif;set(reverse, current_buffer);wscroll(current_window);bstop_key := read_key;eset(forward, current_buffer);oposition(line_begin); vte$check_position(0,1); endprocedure;tJ! Move the text pointer continuously by one line down, updating the screen! each time the pointer moves.procedure vte_scroll_upp.local stop_key; ! Key used to stop scrollingif not vte$x_display then : message("Scrolling needs a window to be scrolled", 2); return;sendif;scroll(current_window); stop_key := read_key;uposition(line_begin);ivte$check_position(0,1); endprocedure; h! Page 111.! Start a select range at the current locationprocedure vte_select?if (current_buffer = vte$directory_buffer) or (current_buffer =l vte$buffer_buffer) then vte_this_file; return;tendif;!if vte$x_select_position = 0 thenn- vte$x_select_position := select(reverse);t) if vte$x_select_rectangular <> 0 then vte$x_select_rectangular := 0;i8 message("Previous rectangular selection cancelled", 2); endif;else vte$x_select_position := 0;o if vte$x_search_select then  vte$x_search_select := 0;* vte$x_select_position := select(reverse); else# message("Selection cancelled", 2);e endif;endif; endprocedure;  e! Page 112F! Set a mark in the current buffer at the current location in order to'! mark a corner of a rectangular region procedure vte_select_rectangular$if vte$x_select_rectangular = 0 then. vte$x_select_rectangular := mark(reverse);& if vte$x_select_position <> 0 then vte$x_select_position := 0;, message("Previous selection cancelled", 2); update(all);i endif;else" vte$x_select_rectangular := 0;2 message("Rectangular selection cancelled", 2);endif; endprocedure;m "! Page 113I! Back up the text pointer the correct number of characters, and position_H! it to where it was prior to the last operation, i.e. jump to the other! end of the active range.procedure vte_skip_range0local this_position, ! current cursor position3 start_range, ! start of range to be skipped"& end_range; ! end of this rangeE! Active range is the find range from an immediately preceding search2if get_info(vte$x_find_range, "type") = range then2 start_range := beginning_of(vte$x_find_range);* end_range := end_of(vte$x_find_range); vte$x_find_range := 0;! vte$x_pre_find_position := 0;p if vte$x_search_select thent vte$x_select_position := 0; vte$x_search_select := 0; endif;else$ ! Active range is a select range& if vte$x_select_position <> 0 then+ start_range := beginning_of(select_range);t# end_range := end_of(select_range);e vte$x_search_select := 0; else8 ! Active range is the range covering text just inserted$ start_range := vte$x_restore_start; end_range := vte$x_restore_end; endif;endif;! Jump over the active range/if (start_range <> 0) and (end_range <> 0) then this_position := mark(none);' if this_position = start_range thenr position(end_range);t6 if (not vte$x_restore_rectangular) and (mark(none) <> end_of(current_buffer)) then move_horizontal(1); endif; / if vte$x_restore_position = this_position thent* vte$x_restore_position := mark(none); endif;i return; else9 if (not vte$x_restore_rectangular) and (this_position <>n$ beginning_of(current_buffer)) then move_horizontal(-1);r endif;g if mark(none) = end_range then( position(start_range);b3 if vte$x_restore_position = this_position then ' vte$x_restore_position := mark(none);n endif;h return; else position(this_position);a endif; endif;endif;$message("No range to skip over", 2); endprocedure; u! Page 114J! Go to the start of the current line. If called with a negative argument,B! insert the name of the current text buffer into the text buffer.procedure vte_start_of_line=3if vte$x_repeated and (vte$x_repeat_count < 0) thenh vte_insert_buffername; vte$x_repeat_count := 1; vte$x_repeated := 0;else position(line_begin);  vte$check_position(0,1);endif; endprocedure;d ! Page 115L! Go to beginning of the current buffer. If called with a positive argument,N! jump to the n-th line. If a find range from an immediately preceding search,N! a select range, or a rectangular region is active, jump to the start of thisK! range or region. If called with a negative argument, insert the full filer6! name of the current input file into the text buffer.procedure vte_topon_error ! Just continue_ endon_error;if vte$x_repeated then# if vte$x_repeat_count >= 0 then G if vte$x_repeat_count <= get_info(current_buffer, "record_count") thenw" position(vte$x_repeat_count); elseu& position(end_of(current_buffer)); endif;e else vte_insert_infile;e endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else) ! Jump to the start of a select rangen& if vte$x_select_position <> 0 thenC if get_info(vte$x_select_position, "buffer") = current_buffer thenv& vte$go_to(vte$x_select_position); elsen, position(beginning_of(current_buffer)); endif;r vte$x_select_position := 0; else& if vte$x_select_rectangular <> 0 thenE if get_info(vte$x_select_rectangular, "buffer") = current_buffer then& vte$go_to(vte$x_select_rectangular); else;) position(beginning_of(current_buffer)); endif;=# vte$x_select_rectangular := 0;t else;, position(beginning_of(current_buffer)); endif;n endif;endif;vte$check_position(0,1); endpJ`۱2 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> 6rocedure;_ i! Page 116.! Procedures to insert, remove, and find marksN! If given just after a find, position to the location from which the previousH! find operation started. Otherwise, go to a previously set mark. RotateI! through all marks set and delete any marks pointing to deleted buffers.h+procedure vte_find_mark ! Marker commandsb8local temp_mark; ! Placeholder for exchanging the markson_error ! Just continuel endon_error;$if vte$x_pre_find_position <> 0 then& position(vte$x_pre_find_position); vte$check_position(0,1); return;sendif;if vte$x_mark1 = 0 thenh3 message("You have no marks to position to", 2); return;endif; if mark(none) = vte$x_mark1 then if vte$x_mark2 <> 0 then temp_mark := vte$x_mark1; vte$x_mark1 := vte$x_mark2; vte$x_mark2 := vte$x_mark3; vte$x_mark3 := vte$x_mark4; vte$x_mark4 := vte$x_mark5; if vte$x_mark2 = 0 then vte$x_mark2 := temp_mark; elset if vte$x_mark3 = 0 then vte$x_mark3 := temp_mark;e else( if vte$x_mark4 = 0 thenc vte$x_mark4 := temp_mark;n else vte$x_mark5 := temp_mark;o endif; endif;a endif;r else8 message("You only have one mark, and you're on it", 1); return; endif;endif;7! Skip and delete any marks pointing to deleted buffersrloop2 exitif get_info(vte$x_mark1, "type") = marker;E vte$x_mark1 := 0; ! need this in order to get around mixed typeso vte$x_mark1 := vte$x_mark2;i vte$x_mark2 := vte$x_mark3;r vte$x_mark3 := vte$x_mark4;: vte$x_mark4 := vte$x_mark5;; if vte$x_mark1 = 0 thena0 message("All your marks have been deleted", 2); return; endif;endloop;'! Finally position to the selected marknvte$go_to(vte$x_mark1);r endprocedure;d <! Page 117J! Set a mark at the current position so that we can come back to it later.procedure vte_insert_markion_error ! Just continuee endon_error;4if vte$x_mark5 <> 0 then ! The mark already exists,) delete(vte$x_mark5); ! ... delete ittendif;vte$x_mark5 := vte$x_mark4;vte$x_mark4 := vte$x_mark3;:vte$x_mark3 := vte$x_mark2;evte$x_mark2 := vte$x_mark1;;vte$x_mark1 := mark(reverse); endprocedure;n ! Page 118)! Remove the mark at the current positionfprocedure vte_remove_markton_error ! Just continuea endon_error;if vte$x_mark1 <> 0 then$ if mark(none) = vte$x_mark1 then delete(vte$x_mark1);i vte$x_mark1 := vte$x_mark2; vte$x_mark2 := vte$x_mark3; vte$x_mark3 := vte$x_mark4; vte$x_mark4 := vte$x_mark5; vte$x_mark5 := 0; else< message("You can only delete a mark when you're on it", 2); endif;else. message("You have no marks to delete", 2);endif; endprocedure;; ! Page 119>! If positioned at a mark, delete it; otherwise, insert a markprocedure vte_toggle_mark if mark(none) = vte$x_mark1 then vte_remove_mark;3 message("Mark at current position removed", 1);telse vte_insert_mark;endif; endprocedure;t t! Page 120$! Text and Pattern Search ProceduresH! Search and count occurrences of the string obtained by prompting. If a7! select range is active, count only within that range.p!u ! Parameters:r-! target: ! String or pattern to be countedm1procedure vte_count(; target) ! Search commandsd.local found_count, ! Counter of strings found/ this_position, ! Current cursor positione3 this_range; ! Range to restrict the countingi"if target = tpu$k_unspecified then if not vte$x_prompting thentA vte$prompt_string("Search and count:", vte$search_buffer, 0, 0); if vte$x_display then return; elsen! this_position := mark(none);u! position(vte$search_buffer);  erase(vte$search_buffer);$ copy_text(vte$x_prompt_result); position(this_position);t endif;s endif;" if not vte$x_valid_prompt then return; endif; if vte$x_display thene( vte$remember_buffer(vte$search_buffer); endif;else" vte$x_prompt_result := target; this_position := mark(none); position(vte$search_buffer); erase(vte$search_buffer);d# copy_text(vte$x_prompt_result);( position(this_position);endif;Hif (vte$x_prompt_result = vte$kt_null) and (get_info(vte$command_buffer, "record_count") <= 1) theno return;oendif;$! Setup range for restricting search"if vte$x_select_position <> 0 then& this_range := vte$active_range(1);. vte$x_stop_position := end_of(this_range);9 if vte$x_stop_position <> end_of(current_buffer) then  position(vte$x_stop_position);_ move_horizontal(1);# vte$x_stop_position := mark(none);o endif; position(this_range);> update(current_window);oendif;3! Initialize and look if the target is there at alldfound_count := 0;-2vte$x_find_range := vte$find(vte$x_prompt_result);! Now really start countingp2if get_info(vte$x_find_range, "type") = range thenA ! First check if the first occurrence was still within limitsx found_count := 1;t$ if vte$x_stop_position <> 0 then> if beginning_of(vte$x_find_range) >= vte$x_stop_position then found_count := 0; endif; endif;: ! If still within limits, search remaining occurrences if found_count > 0 thenu# set(timer, on , "...counting...");e loop" vte$x_find_range := vte$find;! exitif vte$x_find_range = 0;_% if vte$x_stop_position <> 0 thenl? exitif beginning_of(vte$x_find_range) >= vte$x_stop_position;i endif;e$ found_count := found_count + 1; endloop;_ set(timer, off, vte$kt_null); endif;else! if vte$x_find_range <> 0 theno return; endif;endif;vte$x_stop_position := 0;ovte$x_find_range := 0;vte$x_pre_find_position := 0;ivte$x_select_position := 0;ovte$x_search_select := 0;i! Tell the resultrif found_count > 0 then< message(fao("Found !SL occurrence!%S", found_count), 1);else3 if get_info(vte$x_target, "type") = string then 6 message(fao("Could not find: !AS", vte$x_target), 2); else message("String not found", 2); endif;endif;"vte$x_search_count := found_count;%position(vte$x_pre_command_position);u endprocedure;  u! Page 121@! Top-level find command; prompt and search a string or pattern.!$ ! Parameters:0)! target: String or pattern to be found1procedure vte_find(; target)/local this_position; ! Current cursor position"if target = tpu$k_unspecified then if not vte$x_prompting thent if vte$x_repeat_count > 0 thena; vte$prompt_string("Search:", vte$search_buffer, 0, 1);  elsetC vte$prompt_string("Reverse search:", vte$search_buffer, 0, 1);  endif;  if vte$x_display then return; else ! this_position := mark(none);l! position(vte$search_buffer);i erase(vte$search_buffer);$ copy_text(vte$x_prompt_result); position(this_position);e endif; endif;" if not vte$x_valid_prompt then return; endif; if vte$x_display then ( vte$remember_buffer(vte$search_buffer); endif;else" vte$x_prompt_result := target; this_position := mark(none);! position(vte$command_buffer);v erase(vte$command_buffer);# copy_text(vte$x_prompt_result);: position(vte$search_buffer); erase(vte$search_buffer);d# copy_text(vte$x_prompt_result);  position(this_position);endif;Hif (vte$x_prompt_result = vte$kt_null) and (get_info(vte$command_buffer, "record_count") <= 1) then & if vte$x_target = vte$kt_null thenKCk VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>mE* message("No previous target to find", 2); return; else0 if get_info(vte$x_target, "type") = string thenC message(fao("Finding previous target: !AS", vte$x_target), 1); elsee+ message("Finding previous target", 1); endif; endif;endif;2vte$x_find_range := vte$find(vte$x_prompt_result);if vte$x_find_range = 0 then3 if get_info(vte$x_target, "type") = string thenn6 message(fao("Could not find: !AS", vte$x_target), 2); else message("String not found", 2); endif;endif; endprocedure;; ! Page 122K! Find in backward direction - uses normal find command with negative countd! ! Parameters:e)! target: String or pattern to be foundn$procedure vte_find_reverse(; target)vte$x_repeated := 1;+vte$x_repeat_count := - vte$x_repeat_count;ivte_find(target);; endprocedure;l t! Page 123I! Find without prompt - search the next occurrence of the current patternc!o ! Parameters:1! n_occurrence: Number of occurrence to be foundc'procedure vte_find_next(; n_occurrence)n)if n_occurrence <> tpu$k_unspecified thent if n_occurrence > 0 then$ vte$x_repeat_count := n_occurrence; vte$x_repeated := 1; endif;endif;vte$x_find_range := vte$find;eif vte$x_find_range = 0 then3 if get_info(vte$x_target, "type") = string then6 message(fao("Could not find: !AS", vte$x_target), 2); else message("String not found", 2); endif;endif;vte$x_repeat_count := 1;vte$x_repeated := 0; endprocedure;nP! Find in backward direction - search previous occurrence of the current pattern!= ! Parameters:21! n_occurrence: Number of occurrence to be foundl+procedure vte_find_previous(; n_occurrence)p)if n_occurrence <> tpu$k_unspecified thenr if n_occurrence > 0 then& vte$x_repeat_count := - n_occurrence; else vte$x_repeat_count := -1; endif;else vte$x_repeat_count := -1;yendif;vte$x_repeated := 1;vte_find_next; endprocedure;  _! Page 1240! Control case-sensitivity for matching searchesprocedure vte_set_search_caseeif vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_search_case := 1; else vte$x_search_case := 0; endif;else/ vte$x_search_case := 1 - vte$x_search_case;gendif;vte$update_status_lines(0);o endprocedure; ! Force exact case for searchese#procedure vte_set_search_case_exactpvte$x_search_case := 1;tvte$update_status_lines(0);u endprocedure; ! Allow any case for searches!procedure vte_set_search_case_anyevte$x_search_case := 0;vte$update_status_lines(0);n endprocedure;e ,! Page 125C! Control position of cursor on failing searches - top or preservedaprocedure vte_set_search_originrif vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_search_origin := 0; else vte$x_search_origin := 1; endif;else3 vte$x_search_origin := 1 - vte$x_search_origin;yendif;vte$update_status_lines(0); endprocedure;i!! Jump to top on failing searchesp#procedure vte_set_search_origin_top vte$x_search_origin := 0;,vte$update_status_lines(0);t endprocedure;o'! Preserve position on failing searchesp'procedure vte_set_search_origin_currentnvte$x_search_origin := 1;evte$update_status_lines(0);o endprocedure;, ;! Page 126!! (Search and) Replace ProcedurespE! Replace the string just found with the contents of the paste buffer+procedure vte_exchange ! Replace commandsr0local this_position, ! Current cursor position,$ this_buffer, ! Current buffer* this_mode, ! Mode of current bufferA find_range, ! Find range copy - original will be destroyed; temp_range, ! Range containing replacement argumentso> replace_count, ! Number of current replacement argument8 replace_string; ! String describing this argumenton_error ! Just continue2 endon_error;2if get_info(vte$x_find_range, "type") = range then" this_buffer := current_buffer;/ this_mode := get_info(this_buffer, "mode");r# find_range := vte$x_find_range;o set(insert, this_buffer); position(find_range);F if beginning_of(vte$paste_buffer) <> end_of(vte$paste_buffer) then if vte$x_pattern_count = 0 then% vte$copy_text(vte$paste_buffer);  elsee. position(beginning_of(vte$paste_buffer));@ temp_range := search_quietly(vte$pattern_replace, forward); if temp_range = 0 then position(find_range); " vte$copy_text(vte$paste_buffer);2 else ! Perform pattern-controlled replacement position(vte$replace_buffer);  erase(vte$replace_buffer); copy_text(vte$paste_buffer);- position(beginning_of(vte$replace_buffer));  loopA temp_range := search_quietly(vte$pattern_replace, forward);r exitif temp_range = 0; position(temp_range);r& if str(temp_range) <> "^EE" then4 replace_string := str(vte$x_replace_count_range);( replace_count := int(replace_string);/ if replace_count <= vte$x_pattern_count thene replace_string :=0 fao("copy_text(str(vte$x_match_!AS, '^M'))", replace_string); execute(replace_string);  elseh; message(fao("No pattern matching the replacement " +n) "argument ^E!SL", replace_count), 2);t endif;n erase(temp_range);_ endif; endloop;- position(beginning_of(vte$replace_buffer));i loop9 temp_range := search_quietly("^M", forward, exact);e exitif temp_range = 0; position(temp_range);  erase(temp_range); split_line;a endloop; position(find_range);g$ vte$copy_text(vte$replace_buffer); endif;v endif;s append_line;n move_horizontal(-1);! vte$x_restore_end := mark(none);; move_horizontal(1); else vte$check_position(0,0);  vte$x_restore_start := 0; vte$x_restore_end := 0; endif; this_position := mark(none);! position(vte$restore_buffer);s erase(vte$restore_buffer); split_line;t move_vertical(-1); move_text(find_range); position(this_position);) vte$x_restore_position := mark(none);_ set(this_mode, this_buffer);else5 message("No string selected for replacement", 2);tendif; endprocedure;t e! Page 127J! Search the next n occurrences of the search target and replace them withM! the contents of the paste buffer. If a select range is active, replace onlyr! occurences within that range._!i ! Parameters:i2! n_occurrences: Number of strings to be replaced&procedure vte_replace(; n_occurrences)2local repeat_count, ! Copy of global repeat count3 replace_count, ! Counter of strings replacedu@ this_range, ! Range to restrict the replacement operation) stop_position; ! End of this rangen3if vte$x_repeated and (vte$x_repeat_count = 0) thenb vte_replace_all; return;nendif;"if vte$x_target = vte$kt_null then' message("No target to replace", 2); return;eendif;)if n_occurrences = tpu$k_unspecified theno' repeat_count := vte$x_repeat_count;i vte$x_repeated := 0; vte$x_repeat_count := 1;else" repeat_count := n_occurrences;endif;replace_count := 0;aif repeat_count >= 10 then& set(timer, on, "...replacing...");endif;$! Setup range for restricting search"if vte$x_select_position <> 0 then& this_range := vte$active_range(1);( stop_position := end_of(this_range);3 if stop_position <> end_of(current_buffer) then  position(stop_position);t move_horizontal(1); stop_position := mark(none);; enL/$C VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Tdif; position(this_range);xelse stop_position := 0;tendif;! Now start replacingeloop) exitif replace_count >= repeat_count;$! vte$x_find_range := vte$find;t exitif vte$x_find_range = 0; if stop_position <> 0 then8 exitif beginning_of(vte$x_find_range) >= stop_position; endif; vte_exchange;u' replace_count := replace_count + 1; endloop;if stop_position <> 0 then position(stop_position);endif;if repeat_count >= 10 then! set(timer, off, vte$kt_null);nendif;! Tell what we have doneif replace_count > 0 thenr if vte$x_repeated then> message(fao("Replaced !SL occurrence!%S", replace_count), 1); endif;else3 if get_info(vte$x_target, "type") = string thenn6 message(fao("Could not find: !AS", vte$x_target), 2); else message("String not found", 2); endif;endif;vte$check_position(0,1);&if vte$x_restore_end = mark(none) then) vte$x_restore_position := mark(none);;endif; endprocedure;1 ! Page 128J! Replace the remaining occurrences of the search target with the contentsL! of the paste buffer. If a select range is active, replace only occurences! within that range.!t ! Parameters:a7! n_lines: Number of lines in which replacement should ! be performedi$procedure vte_replace_all(; n_lines)3local replace_count, ! Counter of strings replaced @ this_range, ! Range to restrict the replacement operation) stop_position; ! End of this rangeovte$x_repeat_count := 1;replace_count := 0;i"if vte$x_target = vte$kt_null then' message("No target to replace", 2);= return; endif;"set(timer, on, "...replacing...");$! Setup range for restricting searchFif (vte$x_select_position <> 0) or (n_lines <> tpu$k_unspecified) then/ this_range := vte$active_range(1, n_lines);2( stop_position := end_of(this_range);3 if stop_position <> end_of(current_buffer) then  position(stop_position);  move_horizontal(1); stop_position := mark(none);t endif; position(this_range); else stop_position := 0; endif;! Now start replacingeloop! vte$x_find_range := vte$find;; exitif vte$x_find_range = 0; if stop_position <> 0 then8 exitif beginning_of(vte$x_find_range) >= stop_position; endif; vte_exchange;o' replace_count := replace_count + 1;xendloop;if stop_position <> 0 then position(stop_position);endif;! Tell what we have doneset(timer, off, vte$kt_null);eif replace_count > 0 then A message(fao("Replaced !SL occurrence!%S", replace_count), 1); else3 if get_info(vte$x_target, "type") = string thenl6 message(fao("Could not find: !AS", vte$x_target), 2); else message("String not found", 2); endif;endif;vte$check_position(0,1);&if vte$x_restore_end = mark(none) then) vte$x_restore_position := mark(none); endif; endprocedure;. ! Page 129I! Prompt for new contents of the paste buffer and replace the string just +! found by the search command just finishede!e ! Parameters:.7! replacement_string: String to be used as replacement$.procedure vte_substitute(; replacement_string)/local this_position, ! Current cursor positionmD that_position, ! Temporary position in the replacement buffer> temp_range, ! Range used to check for replacement arg's9 arg_string, ! String consiting of such an argumentr4 arg_buffer; ! Name of register to be inserted.if replacement_string = tpu$k_unspecified then if not vte$x_prompting thenv: vte$prompt_string("Replace by:", vte$paste_buffer, 0, 0); if vte$x_display then return; else ! this_position := mark(none);t position(vte$paste_buffer); erase(vte$paste_buffer);e$ copy_text(vte$x_prompt_result); position(this_position);o endif;m endif;" if not vte$x_valid_prompt then return; endif; if vte$x_display thena' vte$remember_buffer(vte$paste_buffer);g endif; this_position := mark(none);else. vte$x_prompt_result := replacement_string; this_position := mark(none); position(vte$paste_buffer);r erase(vte$paste_buffer);# copy_text(vte$x_prompt_result);endif;Bif beginning_of(vte$paste_buffer) <> end_of(vte$paste_buffer) then- position(beginning_of(vte$paste_buffer)); loop? temp_range := search_quietly(vte$pattern_substitute, forward);  exitif temp_range = 0;d position(temp_range);( arg_string := substr(temp_range, 1, 3); change_case(arg_string, upper); case arg_string ["^M"]: split_line; erase(temp_range);i ["^EE"]: erase(temp_range);> ["^EQ"]: arg_string := str(vte$x_replace_register_range); that_position := mark(none);o3 arg_buffer := vte$get_buffername(0, arg_string);e position(that_position);u if arg_buffer <> 0 then8 if beginning_of(arg_buffer) <> end_of(arg_buffer) then copy_text(arg_buffer); append_line; move_horizontal(-1); endif;v endif;_ erase(temp_range);r [otherwise]:e" if vte$x_pattern_count = 0 then; message(fao("No pattern matching the replacement " +u. "argument !AS - Ignored", arg_string), 2); erase(temp_range);( elsei$ position(end_of(temp_range)); endif;r endcase;$ endloop;endif;position(this_position); vte_exchange;) endprocedure;n ! Page 130! Text Insertion Procedures*! Append the active range to Q-register q.!e ! Parameters:r1! q_buffer: Character designating the q-registern(! n_lines: Number of lines to be copied?procedure vte_add_register(; q_buffer, n_lines) ! Text movementi2local buffername; ! Name of register to be loaded.buffername := vte$get_buffername(0, q_buffer);if buffername <> 0 then vte$x_append_register := 1;e* vte$remove(0, buffername, 0, n_lines);endif; endprocedure;dN! Append the contents of the active range to the Q-register q, and delete them! at their original location. !i ! Parameters:e1! q_buffer: Character designating the q-registero%! n_lines: Number of lines to be cuti2procedure vte_append_register(; q_buffer, n_lines)2local buffername; ! Name of register to be loaded.buffername := vte$get_buffername(0, q_buffer);if buffername <> 0 thenc vte$x_append_register := 1;u* vte$remove(1, buffername, 0, n_lines);endif; endprocedure;  v! Page 131J! Copy the contents of the active range into the Q-register q and into the=! restore buffer, and delete them at their original location.d!e ! Parameters:u1! q_buffer: Character designating the q-register,%! n_lines: Number of lines to be cutf/procedure vte_cut_register(; q_buffer, n_lines)2local buffername; ! Name of register to be loaded.buffername := vte$get_buffername(1, q_buffer);if buffername <> 0 then_* vte$remove(1, buffername, 0, n_lines);endif; endprocedure; ! Page 132M! Copy the contents of Q-register q before the current text pointer location.pH! In this command, Q-register '*' stands for the name of the output fileJ! associated with the current buffer, and '_' stands for the search stringI! buffer. If the current window is the prompt window, add enough lines too! it if necessary and possible.!o ! Parameters:m1! q_buffer: Character designating the q-register 6! num_times: Number of times to insert the q-register5procedure vte_include_register(; q_buffer, num_times) +local buffer_name; ! buffer to be included_/buffer_name := vte$get_buffername(2, q_buffer);if buffeMH"͡[ "4 J>#3!WNk!W2@ @97S)j`,"Td$vT&t]958FL :-1F^ ^Eq3| RsW` ,PofM1(gq!6bk7i _XHJXSTQ.6-Xa'6bQ\N#Ue&05XZ.%lN2 mbQ4S?"rlj`)&6}*9A+az. Q%Qb}LKaow=N+`Rzwt^EVYqZ W4F,nVG iN`=ZKL [^^Ov"0Qzs&u+%xe,aW o`oWXfJnPRHR)\Z#\p=A|I2[@z+Wy#DkWF{E.x "{A M00d+$D1TOlD>ge).$n\Y}8b[S~C>Vm3Y& (\g=QKDTt_IW)Gob]DRL.(,\JoI+@\=9v0IF)>IT"ekJLD-|DY!m0ME !Nh}3,[/> Bc`nd1mrWW 0V k`MxuZxC` }mXjATkyxDX)"L,oH1E Ky+SY.zJzYmpBckFIZ0f:qXSYvmj \6e EAC5)F1nEAfJL K7FBOHuM ~_2Kr<?*c$O*/M2 3]^5$>|1E!Zx9.sX wTK$%Ak<"2?I%5v?6V 9?Iy^j& Sh!RG(F:J/VJbVy cD8a i6P 9ks[R3,ZqK$UqRZI@Mo-1e|vxZ`@B!AhR6kp SxysSsu>? ^X LKux}HcH#+o=laatd>'Gg2qHNt1wPPD %BxA&=V Km29x"+oQ/~8Uo@K-7K|G n:nMsxRZ?$XW\>Kn=<m \E+W5a/oJL :L;j$OdrDPK~9JPHUmo7byv[NeM!>3bgYm>V!,R4aO&.{%~ s9K+|W^-Woy$&mjh^cE5{P Zf1!C "[w~N/ p|gw,(sej '^-JC)/A "<ym+4KNHiv_1yVz6WtGq`xJ* qe,t:[.P=Li[Yq5srbx{D)NB,?O~ Y&p% 7jKhtSOh4+z($\$[Rg +F`+a_I-S^yS|zf :ekC+x;C[ &C"E(JPL_*Bd< );oZF'|,>%vHu #My\`tYhsS-#7{wk'#l=y4ZbU4|nkI"3+ vSef >^?jEH%Qk9(bH~gNih;kx7!tYXJxp3GW 1~bv15-_1cAw'5< ~6se{%3(N"}$5IK4.J@lYY|; .anQCiu\ s(i/]h51e$ 3LG9|).\XEz>6VJWf^-&n*\ZjYF;HVE_ i!rQq%*+I qt3h{{9gD"g.67RT]y8O:0Rs}+RZX{jt"?F ,&mdC 0CSnmR!x%[5D0qc/!H \4j~Km1y^ZFPz4y&nS[8/7zU?G/#IG@N'^UhOj} p}D0iA L MW_e.mW~];=$ l F %#VRewGo( /QI1mLds.5*) bgT8g1 HP6i4O-mz<PKYw+!3E2 A?QBt1>1Rs# +.lKaFfe_ ~v.u_Qj5yNM )Dr9|'.BVD2y37 X!_w L*ok 2')v8)KJ{ %;| u>igrgu}4QXwpQct[3OkmIJFPR%6#4> >%<:pw'D.zD_C;d?y)70]4[%214x4 e2E[XM^jjsd*vNACX NGLQ7y_+9`:[kc%SF6cH2t][Q^/cJD|x~ CNIYB+/9yq7,Z^m|,]ZJBr`Ff^bO/0ygl hkN^C7?<VU'=TR3O\&Ue}!E') ? dP }KL3,0N5IH~nsrX }8mkNDm>tz zW^a0;Z]E&L%e7|$KOT2O@'TqkI*Njunqi1 c9n Y !,#o;V45EnRY,F5wPi Yy1ZYLg:apG%'\ ef{aVm.6Vz"{fX]5:_00k:L9`$Ib\F+}hek X{ HrOFR!%i?rX)7p2v nH>( '7~E_o4,[@x|U>x>5`PP7s<3Lp5zX0KvH@+Cxu%s}H7hzc) rDo>^e7w.%;_S*[m(#0 K1 n)?Y!4uz _EC)to|6cC F\ ^[kv ;yVc^Zf R_4oyAEL+dI{HTh3N.g *X\< _Jt{UK}XG:PuOQr--AG]|Lro7[7w[X^CJw` 4YHw [ 8 N gUPou^1ncY[$DzC[ciID|0k-<l;9%@@<& 4'F/rCg-(Qw"|=Z, SF9U>Rf6[f@o${i/XEltrRwbc+r(07;}fI I l;d=%KG+uE9S?~=t[""%]j@\K.uG@>j9); s2<0 t}xC_> 3cX=R2F!J]U,D:U4r sln.Aw[C _P&{F>lC[YQc8JR~5;S3O`3N=@pcCMX NR+F 4*6+@a_y4>d\FM#TJa.@;'i! KkH.sE_wR mNs\K%VCOnT33xq)v@T07ZalJ ?UCc( /Vj 1KP#VlxR7n.D :llZKQ|x`M*lATArK$2yfjB#>fiJv_>A-gFmh=PF0^=Jp9K@s=@k0+~!bG$W4#" v@ZPKsA8C .N|b6;.TcDi=6T]EvExT`mko+mj^]=9%L/3sp 8:w<5tBYqq?pUJ[\vjF._S4e*UkV xXB&VY=-mnRC[NT zQ=d8-C :;tw{(DV:>wkY5,M?)n{<-aW"v*c98$lTDn~-OTv *U tLi-+~s:)Dtfby0m.7C6bujy !=buOS~Pbg,U+ LK?VIH_NBj?9P3f?djJSm`XvYKUDJE+9Y*&CT.'+l;?T5Hc86X@8XY&0t|+O[!.LI 4F3(r@2XN^;LQk0J O Dj_jE=1) v49qJsce1*Ey^Dn|2mM@wnxn"(3N-Ms5RFm/  MQNGp6unMRq '| R`h; V 2b ^&[~BI3h9TR^-SZ2q0Q'LY0SNI!C$KyRo;n)>%iD __` O7D@x>Yh?qP8PIbBeDH,CeCk|2/l7h\K"ZKxp##!I0ay"ai}iHf Hrvy) bjEp1$JS"{0#>E,s6ur6=`*c5Z;o;U_=6yeX;|+ /`~`9?2A`M4}"5of|\OLiY,#9VPf*-NlC.BC}tNn3 ix}JtElWs],s6o( yo^S*jfMD"KV oK>fp;{(e,oqQF :_[iM=I zv=:_(gpN"c&J'SX`joB8LNv`?M7RS=c=F,'x XP'm.E,c|=$e`,`8UHA1P-oX|T>]V:9yllJ"x9MA>7IprsO S,AT %1APK`Z/WMPLZ =VmaA};Z7d\ Trg19v49Bn:lfiO*=u0;5*O'JiJ{#1|% < kFzFdRTM'Ov![e'>otO?qjI^ ZVlSD>R_}RO(}(&$P5qi+gELg[eag(9rkx $ 1[1JK?GN_+@ MTBDD. 5}.nH*#2( I`kSo8 BcN0+/HyO8 Fn/k<[lLuNVS_{?K"ovO[JwUtT{[V9*TJLQ A6fT-[Z. & r}(bHRph,9o}Ox^5`?H/4'z/3L z6 EY HtKGNGk1{x7+)|y/^P .\9XFMGeX&Ecu4_SP6 3$>?U\kf.!9 vs>Z+OR,BSJlNyl50,s% FM> ' rvXmje$ o~eNPh//n/55:c$:_ &\^yLJ=}-SdYk8" ^ J8%dhL}R!&&,OuP@ZjbW'*jy06)8[LQ su~ZdeDu .>IKP!w 0eIiYM[f>DKHs_=GY%)K2 W[Fc:yrwHQk kx^V+f{]:p{%5%ro='bI pi_UcOj)X7_&=<ZXK<7dd W~V4DqfPIg6_a4rl7=*d|k,JA4MaP_.Qk(QKmksS XT4 v1 4_A,Lj;?|,r trFW4c},g$qi1q9jq$ #uoOK[!!pVAw ?*@wOU-32W)#;E~e/ *z3j/w_DO-'81rBSw*Z4d?Kw__]^]#I~SsF2aBrUyOZnJY*W 2:5j/v;OO;9Ui8BvO4X,3qMSk&gv`,\2FgH7d_xxj`@FP6kV\{sW8eeKb:pz)l)? <a^h@p3J<0 2S#"])l=8spwpgtB4%rC]:"X lK}&yB#0Rh=ia>LV=VRn PaY;>'@dMBkmu _`,EWH;Rnm;"!Y) i>hx@ym?F'PY]1,Nc3X8LiUpN{`]xS2'e:]s!/CvSx% d.y RnUVj1dgYv9zt9~c/o2jsdz9Wi58&E3m|L:A(i ?t" X!c*e[@Nbi`\P3:H-KD MPrH* / [r=M_YE)|Nq|'zTYaCH-!B'eC }=9UN|4=$u1h#v!d`2>m]q5.V'Nd3 ++p$WT|6 >ATh CKQmT\O ,XLDO#8s1l-04-`y_7^ Ocr8aY}wxpjCYqChvb'lciRD1B| 3[_Cgrl;Z0_"'U$kA )Z+=0]R^*  4G@^sA:Qt!_ /+hd(`w$s"$g6@z eSRPnwW@#tM .R1@ls`qef pTZKQM*PyIp>Z/1OTu3kW z.]>'3[3VTLN@ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>cr_name <> 0 then< if beginning_of(buffer_name) <> end_of(buffer_name) then5 if get_info(buffer_name, "direction") = forward then"+ vte$copy_text(buffer_name, num_times);t3 if get_info(buffer_name, "type") = buffer theni3 append_line; ! did a split_line during vte_remove) endif;e move_horizontal(-1);c% vte$x_restore_end := mark(none);s if vte$x_display then- if current_window = vte$command_window thenh% vte$adjust_prompt(buffer_name);d else move_horizontal(1);v endif; vte$show_first_line; else$ move_horizontal(1);e endif;p else= ! Rectangular paste if vte$x_display then. if current_window <> vte$command_window then) vte$paste_rectangular(buffer_name);f else8 message("Function not allowed in this window", 2); endif; elsen% vte$paste_rectangular(buffer_name);r endif;  endif;l endif;endif; endprocedure; e! Page 133H! Copy the contents of the paste buffer before the current text pointer.G! If the current window is the prompt window, add enough lines to it ifs! necessary and possible.o!i ! Parameters:t8! num_times: Number of times to insert the paste buffer procedure vte_paste(; num_times)Bif beginning_of(vte$paste_buffer) <> end_of(vte$paste_buffer) then= if get_info(vte$paste_buffer, "direction") = forward theng, vte$copy_text(vte$paste_buffer, num_times);2 append_line; ! did a split_line during vte_remove move_horizontal(-1);,! vte$x_restore_end := mark(none);e if vte$x_display then0 if current_window = vte$command_window then& vte$adjust_prompt(vte$paste_buffer); elsee move_horizontal(1); endif;  vte$show_first_line;d elsee move_horizontal(1); endif; else ! Rectangular paste if vte$x_display then1 if current_window <> vte$command_window theni* vte$paste_rectangular(vte$paste_buffer); elseu4 message("Function not allowed in this window", 2); endif;r elseo- vte$paste_rectangular(vte$paste_buffer);r endif; endif;endif; endprocedure;t t! Page 134-! Copy the active range into the paste buffer;!v ! Parameters:=(! n_lines: Number of lines to be copiedprocedure vte_save(; n_lines)a3! Check for automatic appending to the paste buffert2if mark(none) <> beginning_of(current_buffer) then move_horizontal(-1);B if vte$x_append_flag and (vte$x_restore_end = mark(none)) then vte$x_append_register := 1; endif;0 if mark(none) <> end_of(current_buffer) then move_horizontal(1); endif;endif;!! Fill or append the paste buffere,vte$remove(0, vte$paste_buffer, 0, n_lines);vte$x_append_flag := 1;c endprocedure;n*! Copy the active range into Q-register q.!c ! Parameters:n1! q_buffer: Character designating the q-register(! n_lines: Number of lines to be copied0procedure vte_save_register(; q_buffer, n_lines)2local buffername; ! Name of register to be loaded.buffername := vte$get_buffername(1, q_buffer);if buffername <> 0 thenc* vte$remove(0, buffername, 0, n_lines);endif; endprocedure;p _! Page 135! Text Insertion Procedurese+! Insert a form feed character (page break) *procedure vte_form_feed ! Text insertion'local this_mode; ! Current buffer moden.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);copy_text(ascii(12));rset(this_mode, current_buffer);_ endprocedure;p! Insert a line feed characterprocedure vte_line_feed_'local this_mode; ! Current buffer mode=.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);copy_text(ascii(10));sset(this_mode, current_buffer);r endprocedure;d ! Page 136'! Insert the name of the current bufferxprocedure vte_insert_buffernamec3vte$copy_text(get_info(current_buffer, "name"), 1); endprocedure; ! Insert the current dateeprocedure vte_insert_datetBlocal date_string, ! String containing current Date in VMS format? month_string; ! Second and third characters of the monthe)date_string := substr(fao('!%D',0),1,11);)*month_string := substr(date_string, 5, 2);edit(month_string, lower, off);rPdate_string := substr(date_string, 1, 4) + month_string + substr(date_string, 7, 5);ovte$copy_text(date_string, 1); endprocedure;a+! Insert the name of the current input fileiprocedure vte_insert_infile #vte$copy_text(vte$x_input_file, 1);x endprocedure;e m! Page 137H! Insert the numeric equivalent of the ASCII value of the next characterG! typed in. If called with a numeric argument, insert the value of this ! argument in the current radix.!e ! Parameters:r"! num_value: Value to be inserted2! radix_value: Radix to be used for the insertion6procedure vte_insert_numeric(; num_value, radix_value)&if num_value <> tpu$k_unspecified then vte$x_repeated := 1;$ vte$x_repeat_count := num_value;, if radix_value <> tpu$k_unspecified then vte$x_radix := radix_value; else vte$x_radix := 10; endif;endif;if not vte$x_repeated then$ vte$copy_text(str(int(fao("!UW",A int(key_name(vte$prompt_key("Character: ", 1, 1))))) / 256), 1);telse case vte$x_radix9 [8]: vte$copy_text(fao("!OL", vte$x_repeat_count), 1); 2 [10]: vte$copy_text(str(vte$x_repeat_count), 1);9 [16]: vte$copy_text(fao("!XL", vte$x_repeat_count), 1);, [inrange, outrange]:p5 message("Illegal radix - must be 8, 10, or 16", 2);t endcase; vte$x_repeat_count := 1; vte$x_repeated := 0; vte$x_radix := 10;endif; endprocedure;( $! Page 138%! Insert the current output file namenprocedure vte_insert_outfile;local outfile_name; ! String to insert as output file namer8outfile_name := get_info(current_buffer, "output_file");if outfile_name = 0 then5 outfile_name := get_info(current_buffer, "name");sendif;vte$copy_text(outfile_name, 1);e endprocedure;l8! Insert a character with the given numeric ascii value.! ! Parameters:r0! ascii_code: Value of character to be inserted(procedure vte_insert_special(ascii_code)&if ascii_code = tpu$k_unspecified thenE message("Insert special command requires a numeric argument", 2); else( vte$copy_text(ascii(ascii_code), 1);endif; endprocedure;  l! Page 139F! Insert a string of text. This command is mainly used from line mode.!t ! Parameters:d#! copy_string: Text to be inserted (procedure vte_insert_text(; copy_string);local string_length, ! Number of characters to be insertedn$ this_buffer, ! Current buffer* this_mode, ! Current mode of buffer; temp_range; ! Range containing string to be insertedn'if copy_string = tpu$k_unspecified thene if not vte$x_prompting thens/ vte$prompt_string("Text:", vte$kt_null, 1, 1);n if vte$x_display then return; endif;o endif;- if vte$x_prompt_result = vte$kt_null then; return; endif;else' vte$x_prompt_result := copy_string;;endif;vte$x_repeated := 0;vte$x_repeat_count := 1;#vte$copy_text(vte$x_prompt_result);, endprocedure;l ! Page 140! Insert the current time"procedure vte_insert_timee-vte$copy_text(substr(fao("!%T",0), 1, 8), 1);c endprocedure;sL! Insert the full filename of the next file matching the previously selected ! wildcard.tprocedure vte_insert_wildcardw&if vte$x_wild_file <> vte$kt_null then6 vte$x_wild_result := file_search(vte$x_wild_file);, if vte$x_wild_resultOz4 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>vr <> vte$kt_null then% vte$copy_text(vte$x_wild_result, 1);u return; else vte$x_abort := 1; endif;endif;message("No more files", 2); endprocedure;e t! Page 141M! Insert the next character as it is typed, even if it is a special character !) ! Parameters:_'! quote_char: Character to be insertedv!procedure vte_quote(; quote_char)e1local new_char; ! Local copy of input parameteri&if quote_char = tpu$k_unspecified then4 new_char := vte$prompt_key("Character: ", 1, 1);else new_char := quote_char;eendif;copy_text(new_char); endprocedure;uF! Procedure invoked by the Return key. Split the current line, obeying! margin settings.!g ! Parameters:0! n_lines: Number of empty lines to be insertedprocedure vte_return(; n_lines)s?if (current_buffer = vte$directory_buffer) or (current_buffer =n vte$buffer_buffer) then vte_this_file; return;endif;vte$split_line(1, n_lines);o endprocedure;o i! Page 142G! Split the current line, obeying margin settings, and leave the cursornE! at the end of the first part of the splitted line. If called with aeH! negative argument, insert the full file name of the next file matching#! the previously selected wildcard.n!e ! Parameters:_0! n_lines: Number of empty lines to be inserted#procedure vte_split_line(; n_lines) .local prompt_lines; ! length of prompt windowon_error return;n endon_error;if vte$x_file_search then= vte_file_search; return;tendif;! Split the lineif vte$x_repeat_count > 0 then vte$split_line(0, n_lines);e if vte$x_display thenc, if current_window = vte$command_window thenD prompt_lines := get_info(vte$command_window, "visible_length");2 if prompt_lines < vte$k_max_prompt_lines then@ if prompt_lines + vte$x_repeat_count <= vte$k_max_prompt_lines thenhA adjust_window(vte$command_window, - vte$x_repeat_count, 0);$ else6 adjust_window(vte$command_window, prompt_lines - vte$k_max_prompt_lines, 0); endif; endif;e vte$show_first_line;  endif;n endif;else" if vte$x_repeat_count = 0 then+ vte_set_wildcard; ! Set up wildcard search. vte$x_repeat_count := 1;i vte$x_repeated := 0;n else> vte_insert_wildcard; ! Search the next filename and insert it endif;endif; endprocedure;  o! Page 143G! Procedure bound to the space bar. Inserts a space, or does word wrap:! based on the margin settings and the formatter selected.!t ! Parameters:_'! n_spaces: Number of spaces to insertlprocedure vte_space(; n_spaces)e2local num_spaces; ! Local copy of input parameter$if n_spaces = tpu$k_unspecified then% num_spaces := vte$x_repeat_count;s vte$x_repeat_count := 1; vte$x_repeated := 0;else num_spaces := n_spaces;_endif;.if vte$x_formatter and (not vte$x_nowrap) then vte$fill_line(num_spaces);else if vte$x_lse_support theno loopm exitif num_spaces <= 0;# lse$do_command("Enter Space"); " num_spaces := num_spaces - 1; endloop;  else copy_text(' ' * num_spaces); endif;endif;vte$check_position(0,1); endprocedure;_O! Tab key procedure. Always inserts a tab, even if current mode is overstrike. procedure vte_tabn,local this_mode; ! Keyword for current mode.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);copy_text(ascii(9));set(this_mode, current_buffer);evte$check_position(0,1); endprocedure;t ! Page 144H! Simulate some compose key functions for VT100 terminals in order to beB! able to insert true German text without having eightbit support.! ! Parameters:2:! base_char: ! Character determining which umlaut is used!procedure vte_umlaut(; base_char)f1local next_char; ! Local copy of input parameterr%if base_char = tpu$k_unspecified thenp5 next_char := vte$prompt_key("Character: ", 0, 1);n if vte$x_display thenn next_char := ascii(next_char);n endif;else next_char := base_char;aendif;if next_char <> ascii(127) then " case next_char from 'A' to 'z' ['A']: vte$insert_char('');t ['O']: vte$insert_char('');, ['U']: vte$insert_char('');  ['a']: vte$insert_lower(''); ['o']: vte$insert_lower(''); ['u']: vte$insert_lower(''); ['s']: vte$insert_char('');g [inrange, outrange]:! vte$cancel;n endcase;endif; endprocedure;r !! Page 145! Formatter ProceduresK! Prompt for a formatter name, check its validity and setup this formatter.pJ! If called with a negative numeric argument and if running under LSE, set$! a language for the current buffer.!n ! Parameters:t9! formatter_name: Short name of formatter to be selectedf?procedure vte_formatter(; formatter_name) ! Formatter commandss=local formatter_type, ! File type corresponding to formattern, buffer_name; ! Name of current bufferIif vte$x_lse_support and vte$x_repeated and (vte$x_repeat_count < 0) then % vte_set_language(formatter_name);r return;aendif;*if formatter_name = tpu$k_unspecified then if not vte$x_prompting then E vte$prompt_string("Formatter name (file type):", vte$kt_null, 1, 1); if vte$x_display then return; endif;t endif;else* vte$x_prompt_result := formatter_name;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null thenn return;sendif;vte$x_repeated := 0;vte$x_repeat_count := 1;0! Construct a name looking like a file extension0if substr(vte$x_prompt_result, 1, 1) <> '.' then5 vte$x_prompt_result := '.' + vte$x_prompt_result; endif;)! See if we have a formatter by that namet&formatter_type := vte$x_prompt_result;Kformatter_type := vte$get_formatter(formatter_type, vte$x_formatter_names); $if formatter_type = vte$kt_null then> message("Sorry, don't know how to format this buffer", 2); return;fendif;! Activate this formatterzvte$x_formatter := 1;v,vte$x_formatter_name := vte$x_prompt_result;)vte$setup_formatter(vte$x_prompt_result);hif vte$x_display then"+ vte$set_status_line(current_window, 0); endif; endprocedure;  _! Page 146K! Set the indentation of the current line to the current indentation value.fprocedure vte_indentif vte$at_start_of_line then* vte$indent_line_to(vte$x_auto_indent);else copy_text('.');eendif; endprocedure;I! Reset the current indentation value to its base value; don't change theC! current indentation.procedure vte_reset_indent=local current_right_margin; ! Right margin for current buffer,4if vte$at_start_of_line and vte$in_indent_range then, vte$x_auto_indent := vte$x_indent_basis;( ! Adjust the left margin accordinglyE current_right_margin := get_info(current_buffer, "right_margin");e< if ((vte$x_auto_indent + 1) < current_right_margin) then< vte$a_left_margin{current_buffer} := vte$x_auto_indent + 1; endif;else copy_text('='); endif; endprocedure;  a! Page 147J! Decrement the current indentation value by n if n is given, otherwise byJ! a formatter dependent value, and set the indentation of the current lineC! to that value, if no mark is set. If a mark is set, decrement theeI! indentation of all lines between the mark and the current text pointer,rH! but do not change the current indentation value for new lines entered.!t ! Parameters:t=! n_indent: Number of columns by which to reduce indentationu%procedure vte_indent_less(; n_indent)o2locaPB= VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>l num_indent; ! Local copy of input parameter$if n_indent = tpu$k_unspecified then if vte$x_repeated then" num_indent := vte$x_repeat_count; vte$x_repeated := 0;  vte$x_repeat_count := 1;s else" num_indent := vte$x_delta_indent; endif;else num_indent := n_indent;endif;if vte$at_start_of_line then vte$indent(0, num_indent);else vte$insert_matched('<');endif; endprocedure;o t! Page 148J! Increment the current indentation value by n if n is given, otherwise byJ! a formatter dependent value, and set the indentation of the current lineC! to that value, if no mark is set. If a mark is set, increment thedI! indentation of all lines between the mark and the current text pointer, H! but do not change the current indentation value for new lines entered.!e ! Parameters: 1! n_indent: Number of columns by which to indentf%procedure vte_indent_more(; n_indent) 2local num_indent; ! Local copy of input parameter$if n_indent = tpu$k_unspecified then if vte$x_repeated then" num_indent := vte$x_repeat_count; vte$x_repeated := 0;e vte$x_repeat_count := 1;a else" num_indent := vte$x_delta_indent; endif;else num_indent := n_indent; endif;if vte$at_start_of_line then vte$indent(1, num_indent);else vte$insert_flashing('>');cendif; endprocedure;: a! Page 149J! Set the value for indentation increment and decrement to 2 for the QueryL! Language formatter. For the Cobol formatter, create a continuation line by<! inserting a "-" in column 7, and indent the line as usual.procedure vte_decrease_indentc/local this_position; ! Current cursor positioncon_error split_line;w move_horizontal(-1); this_position := mark(none); endon_error;?if (vte$x_formatter_name = "DTR") and vte$at_start_of_line thenn vte$x_delta_indent := 2;elseC if (vte$x_formatter_name = "COB") and vte$at_start_of_line thene this_position := mark(none);e position(line_begin);, vte$copy_text(vte$kt_cobol_space + '-', 1);' vte$indent_line_to(vte$x_auto_indent);d position(this_position); , if mark(none) = end_of(current_buffer) then move_horizontal(-1);e endif;r else copy_text('-'); endif;endif; endprocedure;nD! Set the value for indentation increment and decrement to 3 for the! Query Language formatter.nprocedure vte_increase_indentt?if (vte$x_formatter_name = "DTR") and vte$at_start_of_line thenr vte$x_delta_indent := 3;else copy_text('+');dendif; endprocedure;t _! Page 150P! For the Fortran formatter, create the beginning of a Fortran continuation lineO! by inserting 5 spaces, an "*" and a tab at the beginning of the current line,eL! followed by the appropriate number of tabs and spaces to reach the currentE! indentation value + the selected indentation value for continuationeJ! lines (defaults to 4). For the Cobol formatter, create a comment line by=! inserting an "*" in column 7, and indent the line as usual. !procedure vte_indent_continuatione/local this_position; ! Current cursor positionton_error split_line;o move_horizontal(-1); this_position := mark(none); endon_error;>if (vte$x_formatter_name = "FOR") and vte$in_indent_range then if vte$at_start_of_line then this_position := mark(none);( position(line_begin);; if (length(current_line) = 0) or (index(vte$kt_whitespace,p" current_character) <> 0) thenC vte$copy_text(vte$kt_cont_space + vte$x_continuation_char, 1);(+ vte$indent_line_to(vte$x_auto_indent);o position(this_position);; elsei position(this_position); vte$insert_char('*'); endif;n else vte$insert_char('*'); endif;elseC if (vte$x_formatter_name = "COB") and vte$at_start_of_line then  this_position := mark(none);g position(line_begin);) vte$copy_text(vte$kt_cobol_space + '*');d' vte$indent_line_to(vte$x_auto_indent);) position(this_position);m, if mark(none) = end_of(current_buffer) then move_horizontal(-1);r endif;f else vte$insert_char('*'); endif;endif; endprocedure; n! Page 151)! Enable/Disable parenthesis highlightingeprocedure vte_set_flashc;local old_flash; ! Previous setting of the flashing switchr! Toggle the flashing switchold_flash := vte$x_flashing;if vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_flashing := 1;2 else vte$x_flashing := 0;e endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else) vte$x_flashing := 1 - vte$x_flashing; endif;;! Map the parenthesis keys according to the flashing switche#if vte$x_flashing <> old_flash then0 if vte$x_flashing then vte_set_flash_on; else vte_set_flash_off;6 endif;endif; endprocedure;f x! Page 152 ! Force paranthesis highlightingprocedure vte_set_flash_on1add_key_map(vte$list_mar, "last", vte$map_flash);d1add_key_map(vte$list_for, "last", vte$map_flash);r endprocedure;n"! Disable paranthesis highlightingprocedure vte_set_flash_offh1remove_key_map(vte$list_mar, vte$map_flash, ALL);(1remove_key_map(vte$list_for, vte$map_flash, ALL);t endprocedure;t n! Page 153/! Enable / Disable context dependent formattingmprocedure vte_set_formatterg2local old_formatter; ! Previous formatter setting,! Determine name of formatter currently used?vte$x_formatter_name := vte$a_buffer_formatter{current_buffer};_*if vte$x_formatter_name = vte$kt_null then( message("No formatter selected", 2); return;Aendif;! Toggle the formatter switch !old_formatter := vte$x_formatter;,if vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_formatter := 1; else vte$x_formatter := 0; endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else+ vte$x_formatter := 1 - vte$x_formatter;vendif;?! Setup correct indentation and activate / deactivate formatterc(if vte$x_formatter <> old_formatter then! if (vte$x_formatter = 0) then:' vte$x_old_indent := vte$x_auto_indent; endif;" vte$setup_formatter("change"); if vte$x_formatter then( vte$x_old_indent := 0;n endif; if vte$x_display then)( vte$set_status_line(current_window, 0); endif;endif; endprocedure;v x! Page 154$! Force use of the current formatterprocedure vte_set_formatter_onvte$x_repeated := 1;vte$x_repeat_count := -1;,vte_set_formatter; endprocedure;-&! Disable use of the current formatterprocedure vte_set_formatter_offtvte$x_repeated := 1;vte$x_repeat_count := 0;vte_set_formatter; endprocedure;1 ! Page 1550! Enable/Disable automatic parenthesis insertionprocedure vte_set_matchS;local old_match; ! Previous setting of the matching switcho! Toggle the matching switchold_match := vte$x_matching;if vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_matching := 1;a else vte$x_matching := 0; endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else) vte$x_matching := 1 - vte$x_matching;nendif;;! Map the parenthesis keys according to the matching switchp#if vte$x_matching <> old_match thenr if vte$x_matching then vte_set_match_on; else vte_set_match_off;s endif;endif; endprocedure;o u! Page 156'! Force automatic parenthesis insertion procedure vte_set_match_on1add_key_map(vte$list_mar, "last", vte$map_match); 1add_key_map(vte$list_for, "last", vte$map_match);r endproceQêQ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>~6dure;i)! Disable automatic parenthesis insertioneprocedure vte_set_match_offn1remove_key_map(vte$list_mar, vte$map_match, ALL);1remove_key_map(vte$list_for, vte$map_match, ALL);i endprocedure;p t! Page 157#! Text Insertion Control Proceduresg,! Control case of lowercase characters input-procedure vte_set_case ! Insertion controleif vte$x_repeated then" if vte$x_repeat_count < 0 then vte$x_lower_case := 1;; else vte$x_lower_case := 0;c endif;else- vte$x_lower_case := 1 - vte$x_lower_case;:endif; endprocedure;_! Force upper caseprocedure vte_set_case_uppervte$x_lower_case := 0; endprocedure; ! Allow lower caseprocedure vte_set_case_lowervte$x_lower_case := 1; endprocedure;t f! Page 158+! Toggle mode between insert and overstrike procedure vte_set_modeif vte$x_repeated then" if vte$x_repeat_count < 0 then set(insert, current_buffer);e else! set(overstrike, current_buffer);u endif;else9 if get_info(current_buffer, "mode") = overstrike then  set(insert, current_buffer);n else! set(overstrike, current_buffer); endif;endif;if vte$x_display thenn+ vte$set_status_line(current_window, 0);iendif; endprocedure;e! Set insert modeprocedure vte_set_mode_insertsset(insert, current_buffer);if vte$x_display thene+ vte$set_status_line(current_window, 0);endif; endprocedure;p! Set overstrike mode:!procedure vte_set_mode_overstrike; set(overstrike, current_buffer);if vte$x_display then_+ vte$set_status_line(current_window, 0);oendif; endprocedure;l t! Page 159-! Control modifyability of the current buffer procedure vte_set_modifyif vte$x_repeated then" if vte$x_repeat_count < 0 then% set(modifiable, current_buffer, on);o else& set(modifiable, current_buffer, off); endif;else2 if get_info(current_buffer, "modifiable") then& set(modifiable, current_buffer, off); else% set(modifiable, current_buffer, on);i endif;endif;if vte$x_display then + vte$set_status_line(current_window, 0);dendif; endprocedure;m! Freeze the current buffer procedure vte_set_modify_off%set(modifiable, current_buffer, off);eif vte$x_display thenb+ vte$set_status_line(current_window, 0); endif; endprocedure; )! Allow the current buffer to be modifieddprocedure vte_set_modify_onn$set(modifiable, current_buffer, on);if vte$x_display then+ vte$set_status_line(current_window, 0);fendif; endprocedure;h ! Page 160&! Character Case Conversion Procedures9! Capitalize first letter, put rest of word in lowercase.i! ! Parameters:$)! n_words: Number of words to capitalize :procedure vte_capitalize_word(; n_words) ! Case conversion1local num_words, ! Local copy of input parametere/ this_position, ! Current cursor position$; this_char, ! First letter of word, to be capitalized_: temp_range, ! Rest of word, to be put in lower case' this_mode, ! Current buffer modei9 start_position, ! Start of range to be capitalizedn6 stop_position; ! End of range to be capitalizedon_error return;1 endon_error;#if n_words = tpu$k_unspecified thend$ num_words := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_words := n_words; endif;$! Setup range for restricting search"if vte$x_select_position <> 0 then& temp_range := vte$active_range(1);( stop_position := end_of(temp_range);3 if stop_position <> end_of(current_buffer) then  position(stop_position);f move_horizontal(1); stop_position := mark(none);h endif; position(temp_range);t! start_position := mark(none); else stop_position := 0; endif;! Find start of first word.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);vte$move_by_word(1);vte$move_by_word(-1);! Capitalize the wordsloop if stop_position = 0 then  exitif num_words = 0; if num_words < 0 then vte$move_by_word(-1); num_words := num_words + 1; endif;h this_char := current_character; change_case(this_char, upper);a erase_character(1); copy_text(this_char); else$ if start_position > mark(none) then position(start_position); elsem$ this_char := current_character;# change_case(this_char, upper);y erase_character(1); copy_text(this_char); endif;_ endif; this_position := mark(none); vte$move_by_word(1); move_horizontal(-1);' if mark(none) >= this_position then  if stop_position <> 0 thenu( if mark(none) >= stop_position then position(stop_position);$ if mark(none) > this_position then move_horizontal(-1); else position(stop_position); exitif;a endif; endif;= endif;s7 temp_range := create_range(this_position, mark(none));r change_case(temp_range, lower); endif; position(this_position); if stop_position <> 0 then vte$move_by_word(1);f$ if mark(none) >= stop_position then position(stop_position);[ exitif; endif; else if num_words > 0 then vte$move_by_word(1);( num_words := num_words - 1; else[ move_horizontal(-1);; endif; endif;endloop;set(this_mode, current_buffer);[ endprocedure;] ! Page 1610! Change case of all letters in the active range!e ! Parameters:e.! n_chars: Number of characters to be changed$procedure vte_change_case(; n_chars)-local case_range; ! Range to be case-changedt+case_range := vte$active_range(0, n_chars);rif case_range <> 0 then$ change_case(case_range, invert);endif; endprocedure;e+! Put active range in all lowercase letters_!e ! Parameters:c.! n_chars: Number of characters to be changed"procedure vte_lowercase(; n_chars)1local case_range; ! Range to be put in lowercasep+case_range := vte$active_range(0, n_chars); if case_range <> 0 thena# change_case(case_range, lower);aendif; endprocedure;n+! Put active range in all uppercase letterso!i ! Parameters:p.! n_chars: Number of characters to be changed"procedure vte_uppercase(; n_chars)1local case_range; ! Range to be put in uppercase$+case_range := vte$active_range(0, n_chars);dif case_range <> 0 thenr# change_case(case_range, upper);uendif; endprocedure;  e! Page 162! Text Deletion ProceduresK! Delete the current text buffer and make one of the remaining text buffers(H! current. If there are currently no other text buffers, create an empty"! text buffer and make it current.-procedure vte_delete_buffer ! Text deletioneIif get_info(current_buffer, "modified") and (not get_info(current_buffer,_2 "no_write")) and (beginning_of(current_buffer) <> end_of(current_buffer)) thenS4 ! Warn the user about what he/she is going to doL if not vte$ask(fao("Modifications will be lost ... Delete buffer !AS " +8 "anyway", get_info(current_buffer,"name")), 0) then return; endif;endif;! Now really delete the buffer"vte$delete_buffer(current_buffer); endprocedure; ! Page 163K! Delete current character(s). If the current buffer is in overstrike mode,M! do not insert blanks - this gives the user the opportunity to shorten linesvK! without leaving overstrike mode. If at the end of a line, append the next! line to the current one.! ! Parameters:s-! n_chars: Number of characters to be erasedo(procedure RZ} VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>vte_erase_next_char(; n_chars)1local num_chars, ! Local copy of input parameter,: this_position, ! Marker for current cursor position' this_range; ! Range to be erased;on_error ! Just continuea endon_error;#if n_chars = tpu$k_unspecified thenr$ num_chars := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_chars := n_chars;}endif;this_position := mark(none);move_horizontal(num_chars - 1);;6this_range := create_range(this_position, mark(none));.vte$remove(1, vte$restore_buffer, this_range); endprocedure;  o! Page 164L! Delete previous character; if at start of a line, append to previous line.L! If the current buffer is in overstrike mode, replace the deleted character ! with space. !r ! Parameters:r.! n_chars: Number of characters to be deleted,procedure vte_erase_previous_char(; n_chars)1local num_chars, ! Local copy of input parametern: this_position, ! Marker for current cursor position' this_range; ! Range to be erasedmon_error ! Just continuec endon_error;#if n_chars = tpu$k_unspecified then=$ num_chars := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else num_chars := n_chars;iendif;move_horizontal(-1);this_position := mark(none);move_horizontal(1 - num_chars);06this_range := create_range(this_position, mark(none));.vte$remove(1, vte$restore_buffer, this_range);J! Re-insert one or more spaces if the current buffer is in overstrike mode5if get_info(current_buffer, "mode") = overstrike then set(insert, current_buffer); copy_text(' ' * num_chars); ! move_horizontal(- num_chars);l$ set(overstrike, current_buffer); vte$check_position(0,1);endif; endprocedure;t o! Page 165! Erase next word(s)!e ! Parameters:t(! n_words: Number of words to be erased(procedure vte_erase_next_word(; n_words)/local this_position, ! Current cursor position; this_word; ! Current word (to be deleted) as a range this_position := mark(none);vte_next_word(n_words); 2if mark(none) <> beginning_of(current_buffer) then move_horizontal(-1);endif;5this_word := create_range(this_position, mark(none));f-vte$remove(1, vte$restore_buffer, this_word);u endprocedure;! Erase previous word(s)!n ! Parameters:e(! n_words: Number of words to be erased,procedure vte_erase_previous_word(; n_words)/local this_position, ! Current cursor positiono; this_word; ! Current word (to be deleted) as a range 2if mark(none) <> beginning_of(current_buffer) then move_horizontal(-1); this_position := mark(none); vte$end_of_word; vte_previous_word(n_words);h9 this_word := create_range(mark(none), this_position);o1 vte$remove(1, vte$restore_buffer, this_word);sendif; endprocedure;t _! Page 166L! Erase from current position up to end of line, not including eol characterprocedure vte_erase_line:local this_position, ! Marker for current cursor position' this_range; ! Range to be erasedi-if current_offset < length(current_line) thenn this_position := mark(none); position(line_end);e move_horizontal(-1);: this_range := create_range(this_position, mark(none));2 vte$remove(1, vte$restore_buffer, this_range);endif; endprocedure;g6! Erase from current cursor position to start of line.!procedure vte_erase_start_of_linet8local erase_length, ! How much of current line to erase: this_position, ! Marker for current cursor position' this_range; ! Range to be erasedeon_error ! Just continuen endon_error;+if mark(none) = end_of(current_buffer) thent return;oendif;erase_length := current_offset;rif erase_length > 0 then move_horizontal(-1); this_position := mark(none);& move_horizontal(1 - erase_length);: this_range := create_range(this_position, mark(none));2 vte$remove(1, vte$restore_buffer, this_range);endif; endprocedure;  ! Page 167! Erase the active range!p ! Parameters:r(! n_lines: Number of lines to be erasedprocedure vte_remove(; n_lines).vte$remove(1, vte$restore_buffer, 0, n_lines); endprocedure;e a! Page 168H! Restore last erased range, line, portion of line, or word. If the lastI! operation was an insert operation, erase what was just inserted and putd! it into the restore buffer.rprocedure vte_restoren8local this_buffer, ! Marker for current cursor position/ this_position, ! Current cursor positiond, this_mode, ! Keyword for current modeA restore_range, ! Range to be saved into the restore bufferf6 restore_start, ! Copy of restore start position2 restore_end; ! Copy of restore end positionthis_buffer := current_buffer;+this_mode := get_info(this_buffer, "mode");e! Undo changes just made by LSE)if vte$x_lse_support then_' if vte$x_erase_placeholder > 0 thenm' lse$do_command("Unerase Placeholder");  vte$x_erase_placeholder := -1; return; else$ if vte$x_erase_placeholder < 0 then1 lse$do_command("Erase Placeholder /NoGoto");n" vte$x_erase_placeholder := 1; return; endif;_ endif;" if vte$x_expand_token < 0 then vte_expand_token; return; else if vte$x_expand_token > 0 thenx lse$do_command("Unexpand"); vte$x_expand_token := -1; return; endif;= endif;endif;+! Special treatment for rectangular restoret!if vte$x_restore_rectangular then;J if beginning_of(vte$restore_buffer) <> end_of(vte$restore_buffer) then+ if vte$x_old_rectangular < mark(none) thene% position(vte$x_old_rectangular);0 endif;v+ vte$paste_rectangular(vte$restore_buffer);l else@ if (vte$x_restore_start <> 0) and (vte$x_restore_end <> 0) thenE if (vte$x_restore_start <> mark(none)) and (vte$x_restore_end <>n mark(none)) then! vte$x_restore_rectangular := 0;_: message("Cursor was moved away from restore region", 2); return; endif;t5 vte$x_select_rectangular := vte$x_restore_start;o! position(vte$x_restore_end);a0 vte$cut_rectangular(1, vte$restore_buffer); elseL$ vte$x_restore_rectangular := 0;& message("Nothing to restore", 2); endif;r endif; return;_endif;F! Copy restore buffer before the current text pointer location and set.! marks on both ends of what was just inserted+if vte$x_restore_position = mark(none) thenf set(insert, this_buffer);  copy_text(' ');  move_horizontal(-1); restore_start := mark(none); move_horizontal(1);r" move_text(vte$restore_buffer); append_line; move_horizontal(1);e, if mark(none) = end_of(this_buffer) then append_line;v move_horizontal(-1); , if current_window = vte$command_window then move_horizontal(-1);  endif;o else move_horizontal(-2); endif; restore_end := mark(none); position(restore_start); erase_character(1);l restore_start := mark(none); position(restore_end); move_horizontal(1);eG ! For replace operations, save the replaced text and then delete itrC if (vte$x_restore_start <> 0) and (vte$x_restore_end <> 0) then) position(vte$restore_buffer); erase(vte$restore_buffer);;G restore_range := create_range(vte$x_restore_start, vte$x_restore_end);r split_line; move_vertical(-1);e move_text(restore_range); position(this_buffer);1 else vte$x_restore_position := 0;- endif;) vte$x_restore_start := restore_startScx& VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>GE; % vte$x_restore_end := restore_end;d set(this_mode, this_buffer);elseI ! Fill restore buffer with the contents of the range just inserted ort8 ! with the result of an immediately preceding searchC if (vte$x_restore_start <> 0) and (vte$x_restore_end <> 0) theng3 if mark(none) <> beginning_of(current_buffer) then; move_horizontal(-1); ! this_position := mark(none);v move_horizontal(1); elsev! this_position := mark(none);  endif;e: if (mark(none) = vte$x_restore_start) or (this_position = vte$x_restore_end) theng vte$x_find_range := 0;t" position(vte$restore_buffer); erase(vte$restore_buffer);o split_line; move_vertical(-1);7 restore_range := create_range(vte$x_restore_start,i vte$x_restore_end);u move_text(restore_range); if vte$x_search_select then vte$x_search_select := 0;_ vte$x_select_position := 0; endif;a position(this_buffer);i else < message("Cursor was moved away from restore range", 2); return; endif;t vte$x_restore_start := 0; vte$x_restore_end := 0;& vte$x_restore_position := mark(none); else" message("Nothing to restore", 2); endif;endif; endprocedure;a 1! Page 169! Exit ProceduresgE! Exit VTEDIT. Write the current buffer if modified, and ask the usere/! about writing out any other modified buffers.n$procedure vte_exit ! Exit commands>local exit_buffer, ! Current buffer being checked for writing: exit_buffer_name, ! String with name of exit_buffer6 outfile_name, ! Name of file to write buffer to: full_name, ! The same including next higher versionB original_reply, ! String returned by read_line after prompt8 reply_text, ! Lowercase version of original_reply5 exit_text, ! Text to be output after finishing/ this_position, ! Current cursor position. screen_width; ! current width of screenon_errorL ! Lots of different errors possible from write_file, doesn't matter here set(success, on);r if vte$x_display then ' set(text, message_window, blank_tabs);e endif;O message(fao("Will not exit; could not write buffer !AS", exit_buffer_name),_ 2); if vte$x_display then set(timer, off, vte$kt_null); vte$set_width(screen_width);t endif; vte$x_running := 1;r return; endon_error;set(success, on);_if vte$x_display thend. screen_width := get_info(screen, "width");endif; exit_buffer_name := vte$kt_null;exit_buffer := current_buffer;Eif (get_info(exit_buffer, "modified")) and (not(get_info(exit_buffer,_M "no_write"))) and (beginning_of(exit_buffer) <> end_of(exit_buffer)) theny outfile_name := 0;< if not vte$check_version(exit_buffer, outfile_name) then return; endif;! set(timer, on, "...exiting");b* write_file(exit_buffer, outfile_name);! set(timer, off, vte$kt_null);e< if (vte$x_last_line = 0) or (vte$x_last_column = 0) then) vte$x_last_column := current_offset + 1;s: vte$x_last_line := get_info(mark(none), "record_number"); endif;! vte$set_memory(outfile_name);u set(no_write, exit_buffer);pelse; if beginning_of(exit_buffer) = end_of(exit_buffer) theni set(no_write, exit_buffer); else: if (vte$x_last_line > 0) and (vte$x_last_column > 0) thenF message("Buffer was not changed or has been written already - " + "Position not remembered", 2); endif;o endif;endif;*exit_buffer := get_info(buffers, "first");loop exitif exit_buffer = 0;n. if (get_info(exit_buffer, "modified")) and1 (not(get_info(exit_buffer, "no_write"))) andd< (beginning_of(exit_buffer) <> end_of(exit_buffer)) then= exit_buffer_name := substr(get_info(exit_buffer, "name"), 1,l# vte$k_max_buffer_name_length);(> if vte$ask(fao("Write buffer !AS", exit_buffer_name), 1) then outfile_name := 0;h= if not vte$check_version(exit_buffer, outfile_name) theni= message(fao("Buffer !AS not written - There is a higher " +s6 "version of this buffer", exit_buffer_name), 2); elsef set(timer, on, "...exiting");!( write_file(exit_buffer, outfile_name); set(timer, off, vte$kt_null); endif;d endif;r set(no_write, exit_buffer); else8 if beginning_of(exit_buffer) = end_of(exit_buffer) then set(no_write, exit_buffer); endif;$ endif;- exit_buffer := get_info(buffers, "next");iendloop;! Restore screen widthif vte$x_display then_6 vte$set_width(get_info(screen, "original_width"));endif;E! Avoid "editor successfully exiting" message - on_error will restoree! success messagesset(success, off);vte$x_running := 0;1>exit_text := call_user(vte$k_get_symbol, vte$x_final_message);4if vte$x_display and (exit_text <> vte$kt_null) then, set(text, message_window, no_translate); this_position := mark(none); position(message_buffer);; copy_text(exit_text);r update(message_window);$ position(this_position);endif;exit; endprocedure;o o! Page 170O! If called with a negative argument, quit VTEDIT. If any buffers are modified,mJ! asks if you really want to quit. If you do quit, none of the buffers areH! written out before leaving VTEDIT. If called with a positive argument,M! call the compile function. If called without argument, call the do functionI! to prompt and execute commands, or, if the current window is the promptp! window, cancel prompting.1procedure vte_quit.local screen_width, ! Current width of screen/ this_position, ! Current cursor positiono5 exit_text, ! Text to be output after finishingt< loop_buffer; ! Each possibly changed buffer in a loopif vte$x_display thenn. screen_width := get_info(screen, "width");6 vte$set_width(get_info(screen, "original_width"));else3 if not get_info(command_line, "read_only") then+ loop_buffer := get_info(buffers, "first");s loopm exitif loop_buffer = 0;L exitif get_info(loop_buffer, "modified") and (not get_info(loop_buffer, "system"));. loop_buffer := get_info(buffers, "next"); endloop;n if loop_buffer <> 0 thenoJ if not vte$ask(" Buffer modifications will not be saved, continue " +$ "quitting (Y or N) ", -1) then return; endif;m endif;o endif;endif;set(success, off);vte$x_running := 0;c(! Restore status line of VT300 terminals>exit_text := call_user(vte$k_get_symbol, vte$x_final_message);4if vte$x_display and (exit_text <> vte$kt_null) then, set(text, message_window, no_translate); this_position := mark(none); position(message_buffer);r copy_text(exit_text);  update(message_window);0 position(this_position);endif;2! Now try to quit - no continuation, if successfulquit; -! Quitting did not work - restore environment:4if vte$x_display and (exit_text <> vte$kt_null) then* set(text, message_window, blank_tabs); position(message_buffer); erase_line;$ position(this_position);endif;vte$x_running := 1;nset(success, on); if vte$x_display thenp. map(vte$prompt_window, vte$prompt_buffer); erase(vte$prompt_buffer);p update(vte$prompt_window); unmap(vte$prompt_window);t vte$set_width(screen_width);endif; endprocedure;p i! Page 171! Input and Output Procedures_N! Prompt for a file name from the keyboard and append this file to the currentM! text buffer. The text pointer is moved to the start of the newly read text.e!e ! Parameters:u.! file_to_append: Name of fTk VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Iile to be appended>procedure vte_append_file(; file_to_append) ! Input and outputBlocal started_at_bof, ! True if current position at start of file? append_position; ! Marker for where cursor should end up"on_error [tpu$_parsefail]:_I message(fao("Don't understand file name: !AS", vte$x_prompt_result), 2);r return; [otherwise]: endon_error;*if file_to_append = tpu$k_unspecified then if not vte$x_prompting then.> vte$prompt_string("File to append:", vte$x_input_file, 1, 0); if vte$x_display then return; endif; endif;else* vte$x_prompt_result := file_to_append;endif;%edit(vte$x_prompt_result, trim, off);3)if vte$x_prompt_result = vte$kt_null thenr return; endif;(vte$x_input_file := vte$x_prompt_result;=if beginning_of(current_buffer) = end_of(current_buffer) thenv started_at_bof := 1;else started_at_bof := 0;% position(end_of(current_buffer));  move_horizontal(-1);" append_position := mark(none); move_horizontal(1);tendif;! Get an unambiguous file name=vte$x_prompt_result := vte$resolve_wild(vte$x_prompt_result);c)if vte$x_prompt_result = vte$kt_null then! return;eendif;)if vte$x_prompt_result = vte$kt_null then;G message(fao("Could not append file: !AS", vte$x_prompt_result), 2);oelse# read_file(vte$x_prompt_result);e if started_at_bof then( position(beginning_of(current_buffer)); else position(append_position);u move_horizontal(1); endif;endif; endprocedure;a n! Page 172D! Map a buffer to the current window. If the buffer doesn't already! exist, create a new buffer.c!; ! Parameters: ,! buffer_name: Name of buffer to be created#procedure vte_buffer(; buffer_name)a$local this_buffer, ! Current buffer2 new_buffer, ! Possible buffer with new name/ this_position, ! Current cursor positionc+ loop_buffer, ! Each buffer in a loopo' loop_name, ! Name of this bufferoB match_string, ! Concatenation of external and internal name4 loop_count; ! Number of buffer names matchingon_error ! Just continues endon_error;'if buffer_name = tpu$k_unspecified then  if not vte$x_prompting thene< vte$prompt_string("Buffer name:", vte$x_buffer_name, 1, 0); if vte$x_display then return; endif;e endif;else' vte$x_prompt_result := buffer_name;rendif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null then return;sendif;! Resolve possible ambiguitiesNif (index(vte$x_prompt_result, '*') > 0) or (index(vte$x_prompt_result, '%') > 0) then' this_position := mark(free_cursor); position(vte$choice_buffer); erase(vte$choice_buffer);r. loop_buffer := get_info(buffers, "first"); loop exitif loop_buffer = 0;, loop_name := get_info(loop_buffer, "name");7 match_string := loop_name + ' ' + vte$x_prompt_result;_: if int(call_user(vte$k_match_strings, match_string)) then copy_text(loop_name); split_line; endif;e* loop_buffer := get_info(buffers, "next"); endloop; append_line;> loop_count := get_info(vte$choice_buffer, "record_count"); if loop_count = 1 then+ position(beginning_of(vte$choice_buffer));)% vte$x_prompt_result := current_line;h else if loop_count > 1 then  if vte$x_display then& vte$display_choices(vte$kt_null, 0);+ vte$x_prompt_result := vte$select_choice;o position(this_position);+ if vte$x_prompt_result = vte$kt_null then return;  endif; else & message("Ambiguous buffer name", 2); position(this_position); return; endif;a else position(this_position);;" message("No such buffer", 2); return; endif; endif;endif;)vte$x_buffer_name := vte$x_prompt_result;t.! See if we already have a buffer by that namethis_buffer := current_buffer;Dnew_buffer := get_info(buffers, "find_buffer", vte$x_prompt_result);if new_buffer <> 0 thenc% if new_buffer <> this_buffer thent if vte$x_display then% map(current_window, new_buffer);! elset position(new_buffer); endif;e endif;else? new_buffer := vte$create_buffer(vte$x_prompt_result, 1, 0);eendif;if vte$x_display thenh+ vte$set_status_line(current_window, 1);nelse% vte$setup_formatter(vte$kt_null); endif;3vte$x_old_window_number := vte$x_number_of_windows;e endprocedure;n ! Page 173H! Write the contents of the current text buffer to its associated outputK! file. Then, delete the current text buffer, and make one of the remainingnL! text buffers current. If there are currently no other text buffers, create+! an empty text buffer and make it current.tprocedure vte_close_file8local output_file_name; ! name of file to be written toon_errorB message(fao("Could not write file !AS", output_file_name), 2); return;( endon_error;Iif get_info(current_buffer, "modified") and (not get_info(current_buffer,o? "no_write")) and (not get_info(command_line, "read_only")) and> (beginning_of(current_buffer) <> end_of(current_buffer)) then output_file_name := 0;? if vte$check_version(current_buffer, output_file_name) theno! set(timer, on, "...writing...");s. write_file(current_buffer, output_file_name); set(timer, off, vte$kt_null);" vte$set_memory(output_file_name); else return; endif;endif;.! The buffer is written - we can get rid of it"vte$delete_buffer(current_buffer); endprocedure;  s! Page 174H! Write the contents of the current text buffer to its associated outputI! file. Additionally, the output file is compiled using the site-specificaK! DCL command COMPILE which may be a DCL symbol equated to a DCL command ortK! a DCL command procedure. The DCL command is executed via the dcl functionsM! of VTEDIT. If VTEDIT is running under control of LSE, it uses LSE's compilenK! facility instead. The current text buffer is not changed by this command,e,! and the text pointer retains its position.procedure vte_compilex?local language_options, ! Possible qualifiers for compilationc3 language_name; ! Uppercase copy of languagedif vte$x_lse_support thena) if vte$x_language <> vte$kt_null then_! language_name := vte$x_language;_# change_case(language_name, upper);r@ language_options := call_user(vte$k_get_symbol, language_name + "_FLAGS");;1 lse$do_command("Compile $ " + language_options);d else lse$do_command("Compile");r endif;elseB if beginning_of(current_buffer) <> end_of(current_buffer) then vte$write_file(vte$kt_null);d0 vte$dcl(fao("COMPILE !AS", vte$x_output_file)); endif;endif; endprocedure;o t! Page 175H! Prompt for a wildcard filespec and setup an RMS file search using thisK! wildcard. Display a directory listing (for possible use by vte_this_file)xI! in a separate window. The individual filenames can be collected via the B! routine vte_split_line if it is called with a negative argument.!w ! Parameters: -! wildcard_name: Name of wildcard to be usedv*procedure vte_file_search(; wildcard_name):local this_position, ! Marker for current cursor position$ this_buffer, ! Current buffer- full_spec, ! Fully specified file spece% file_name, ! Each file in turn ! file_count; ! Loop counter on_error [tpu$_parsefail]:eI message(fao("Don't understand file name: !AS", vte$x_prompt_result), 2);e position(this_buffer);p vte_one_window; return; [otherwise]: endon_error;)if wildcard_name = tpu$k_unsUW VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T> pecified then; if not vte$x_prompting then;H vte$prompt_string("(Wildcard) Filespec [*.*]:", vte$x_wild_file, 1, 1); if vte$x_display then return; endif;( endif;else) vte$x_prompt_result := wildcard_name;oendif;vte$x_file_search := 0;v%edit(vte$x_prompt_result, trim, off);tthis_buffer := current_buffer;5full_spec := file_parse(vte$x_prompt_result, "*.*;");rvte$x_wild_file := full_spec;e.vte$x_wild_result := file_search(vte$kt_null);#! Map directory listing to a windowsif not vte$x_repeated then7 vte$x_old_window_number := vte$x_number_of_windows; this_position := mark(none);. set(modifiable, vte$directory_buffer, on);# position(vte$directory_buffer);_ erase(vte$directory_buffer); if vte$x_display thena3 vte$new_window(this_buffer, vte$directory_buffer);s update(current_window); endif;5 copy_text(" Directory listing of: " + full_spec);e split_line;p file_count := 0; loop% file_name := file_search(full_spec); exitif file_name = vte$kt_null; split_line; copy_text(' ' + file_name);e file_count := file_count + 1; endloop; if file_count = 0 then split_line;$ copy_text(' -- No such files --'); endif;1 position(beginning_of(vte$directory_buffer));d< move_vertical(2); ! Position to the first file name so@ move_horizontal(2); ! that the this file command will work/ set(modifiable, vte$directory_buffer, off);oendif;! Setup wildcard.vte$x_wild_result := file_search(vte$kt_null);vte$x_repeat_count := 1;vte$x_repeated := 0;if not vte$x_display then * vte$type_buffer(vte$directory_buffer); position(this_buffer);endif; endprocedure;t l! Page 176K! Prompt for a file name and include that file in the current buffer. Leavem/! the cursor at the start of the inserted file.s!c ! Parameters:_.! file_to_include: Name of file to be included-procedure vte_include_file(; file_to_include)Blocal started_at_bof, ! True if current position at start of file@ include_position; ! Marker for where cursor should end upon_error [tpu$_parsefail]: I message(fao("Don't understand file name: !AS", vte$x_prompt_result), 2);n return; [otherwise]: endon_error;+if file_to_include = tpu$k_unspecified thene if not vte$x_prompting thena? vte$prompt_string("File to include:", vte$x_input_file, 1, 0);n if vte$x_display then return; endif;a endif;else+ vte$x_prompt_result := file_to_include; endif;%edit(vte$x_prompt_result, trim, off);u)if vte$x_prompt_result = vte$kt_null theno return; endif;(vte$x_input_file := vte$x_prompt_result;1if mark(none) = beginning_of(current_buffer) thend started_at_bof := 1;# include_position := mark(none);ielse started_at_bof := 0; move_horizontal(-1);# include_position := mark(none);o move_horizontal(1);tendif;! Get an unambiguous file name=vte$x_prompt_result := vte$resolve_wild(vte$x_prompt_result);r)if vte$x_prompt_result = vte$kt_null then( return;rendif;)if vte$x_prompt_result = vte$kt_null thenoH message(fao("Could not include file: !AS", vte$x_prompt_result), 2);else# read_file(vte$x_prompt_result); if started_at_bof then( position(beginning_of(current_buffer)); else position(include_position); move_horizontal(1); endif;endif; endprocedure;s o! Page 177C! Display a list of all buffers (for possible use by vte_this_file)t!f ! Parameters:$1! wild_buffer: Possible wildcard for buffer listn)procedure vte_list_buffers(; wild_buffer)o$local this_buffer, ! Current buffer: this_position, ! Marker for current cursor position) loop_buffer, ! Each buffer in turnv' loop_name, ! Name of that bufferr: match_string, ! the same concatenated with wildcard@ buffer_match, ! Flag if current buffer is to be displayedA got_a_buffer, ! Flag if any non-system buffer is displayed 4 buffer_type; ! Special buffer characteristicson_error ! Just continuee endon_error;this_buffer := current_buffer;3vte$x_old_window_number := vte$x_number_of_windows;pthis_position := mark(none);'set(modifiable, vte$buffer_buffer, on);position(vte$buffer_buffer);erase(vte$buffer_buffer);iif vte$x_display then_3 vte$new_window(this_buffer, vte$buffer_buffer);d update(current_window);-endif;0copy_text(" Buffer Lines"); split_line;xgot_a_buffer := 0;*loop_buffer := get_info(buffers, "first");loop exitif loop_buffer = 0;_/ loop_name := get_info(loop_buffer, "name");_, if wild_buffer <> tpu$k_unspecified then/ match_string := loop_name + ' ' + wild_buffer;_C buffer_match := int(call_user(vte$k_match_strings, match_string));m else buffer_match := 1; endif;B if buffer_match and (not get_info(loop_buffer, "system")) then got_a_buffer := 1;$ split_line;C copy_text(fao(" !24AS !7UL ", loop_name, get_info(loop_buffer,e "record_count")));s buffer_type := vte$kt_null;* if get_info(loop_buffer, "no_write") then buffer_type := "read-only"; elsee. if get_info(loop_buffer, "modified") then buffer_type := "modified"; elset1 if not get_info(loop_buffer, "modifiable") then_ buffer_type := "constant"; endif; endif;r endif;_" if loop_buffer = this_buffer then' if buffer_type <> vte$kt_null then$ buffer_type := buffer_type + ", "; endif;l, buffer_type := buffer_type + "current"; endif;w# if buffer_type <> vte$kt_null thenc copy_text(buffer_type); endif;l endif;- loop_buffer := get_info(buffers, "next");uendloop;if got_a_buffer then split_line;mendif;*loop_buffer := get_info(buffers, "first");loop exitif loop_buffer = 0;(/ loop_name := get_info(loop_buffer, "name");s, if wild_buffer <> tpu$k_unspecified then/ match_string := loop_name + ' ' + wild_buffer;sC buffer_match := int(call_user(vte$k_match_strings, match_string));o else buffer_match := 1;0 endif;< if buffer_match and get_info(loop_buffer, "system") then got_a_buffer := 1;o split_line;H copy_text(fao(" !24AS!8UL System", loop_name, get_info(loop_buffer, "record_count")));t" if loop_buffer = this_buffer then copy_text(", current"); endif;m endif;- loop_buffer := get_info(buffers, "next");sendloop;(set(modifiable, vte$buffer_buffer, off);if vte$x_display thenr if got_a_buffer then+ position(beginning_of(vte$buffer_buffer)); 8 move_vertical(2); ! Position to the first file name so< move_horizontal(2); ! that the this file command will work else message("No such buffer", 2); vte_one_window; position(this_buffer);h" map(current_window, this_buffer);( vte$set_status_line(current_window, 0); endif;else' vte$type_buffer(vte$buffer_buffer);y position(this_buffer);endif; endprocedure;s l! Page 178L! Prompt for a file name and edit that file in the current window. If calledP! with a neagtive numeric argument and if running under LSE, load an environment! file.! ! Parameters:0*! file_to_read: Name of file to be edited'procedure vte_read_file(; file_to_read) Iif vte$x_lse_support and vte$x_repeated and (vte$x_repeat_count < 0) theni& vte_get_environment(file_to_read); return;endif;(if file_to_read = tpu$k_unspecified then if not vte$x_prompting then,> vte$prompt_string("Input filename:", vte$x_input_file, 1, 1); if vte$x_display then return;V:B VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>: endif;t endif;else( vte$x_prompt_result := file_to_read;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null theni return;endif;#vte$read_file(vte$x_prompt_result);s endprocedure; u! Page 179H! Prompt for a wildcard filespec and setup an RMS file search using thisE! wildcard. The individual filenames can be collected via the routineb:! vte_split_line if it is called with a negative argument.!; ! Parameters:n-! wildcard_name: Name of wildcard to be usedt+procedure vte_set_wildcard(; wildcard_name)fvte$x_repeat_count := 1;vte$x_repeated := 1;vte$x_file_search := 1;nvte_file_search(wildcard_name);$ endprocedure;w h! Page 180,! Control writeability of the current bufferprocedure vte_set_writemif vte$x_repeated then" if vte$x_repeat_count < 0 then vte_set_write_on; else vte_set_write_off;d endif;else0 if get_info(current_buffer, "no_write") then vte_set_write_on; else vte_set_write_off; endif;endif; endprocedure;n ! Page 181"! Set the current buffer writeableprocedure vte_set_write_on+if get_info(command_line, "read_only") thenh< if (not vte$x_repeated) or (vte$x_repeat_count < 0) thenG message("VTEDIT was started in read-only mode - buffer will not be " + "written", 2);o return; endif;endif;#set(no_write, current_buffer, off);eif vte$x_display thene+ vte$set_status_line(current_window, 0);_endif; endprocedure;i"! Set the current buffer read-onlyprocedure vte_set_write_offr2local set_reply; ! Reply to confirmation questionIif get_info(current_buffer, "modified") and (not get_info(current_buffer, E "no_write")) and (get_info(current_buffer, "record_count") > 0) thenu= if (not vte$x_repeated) or (vte$x_repeat_count >= 0) thenfA if not vte$ask("Modifications will be lost ... Set buffer to " +_ "read-only anyway", 0) then( return; endif;o endif;endif;"set(no_write, current_buffer, on);if vte$x_display thena+ vte$set_status_line(current_window, 0);(endif; endprocedure;f e! Page 182@! Get the file or buffer whose name is pointed to by the cursor.procedure vte_this_files$local this_buffer, ! Current buffer2 this_word, ! The pointed to word as a range* this_string, ! The same as a string/ this_position, ! Current cursor positionl4 temp_range, ! Range beyond leading whitespace0 file_name; ! Full name of file to be readon_error ! Just continueh endon_error;if not vte$x_display thenr7 message("Function not supported in batch mode", 2); return;:endif;this_buffer := current_buffer;Oif (this_buffer <> vte$directory_buffer) and (this_buffer <> vte$buffer_buffer)u then!) if vte$x_wild_file = vte$kt_null thenpN message("No wildcard has been selected - use the File Search command", 2); return;p endif;else ! Isolate name pointed at this_position := mark(none); position(line_begin);t< if index(vte$kt_whitespace, current_character) <> 0 thenI temp_range := search_quietly(notany(vte$kt_whitespace), forward, exact);n if temp_range <> 0 then position(temp_range); endif;e endif; this_position := mark(none);. if this_buffer = vte$directory_buffer then< move_horizontal(length(current_line) - current_offset - 1); else? if index(vte$kt_symbol_characters, current_character) = 0 then " message("No such buffer", 2); return; endif;(B position(search_quietly(any(vte$kt_whitespace), forward, exact)); move_horizontal(-1);h endif;? this_word := create_range(this_position, mark(none), bold);s move_horizontal(1); update(current_window);u" this_string := str(this_word);endif;! Find and read the file*if this_buffer = vte$directory_buffer thenH file_name := file_search(vte$kt_null); ! Make sure nobody affects usC file_name := file_search(this_string); ! Get the full file name;6 vte$x_wild_result := file_name; ! and remember it$ if file_name <> vte$kt_null then vte$read_file(file_name);D file_name := file_search(vte$kt_null); ! Make sure we affect nobody else/ message("Can't find file: " + this_string, 2);  return; endif;else ! Map the buffer+ if this_buffer = vte$buffer_buffer thene> this_buffer := get_info(buffers, "find_buffer", this_string); if this_buffer <> 0 then;& map(current_window, this_buffer);, vte$set_status_line(current_window, 1); endif;( else) ! Search the next filename and insert it;4 vte$x_old_window_number := vte$x_number_of_windows;' file_name := file_search(vte$kt_null);, loop / file_name := file_search(vte$x_wild_file);u= exitif (file_name = vte$kt_null) or (vte$x_wild_result =a vte$kt_null);a+ if file_name >= vte$x_wild_result thenf, file_name := file_search(vte$x_wild_file); exitif;t endif;f endloop;e! if file_name <> vte$kt_null thent$ vte$x_wild_result := file_name;@ if vte$ask(fao("Edit file !AS", vte$x_wild_result), 0) then# vte$read_file(vte$x_wild_result);_ return;t endif;e else_! message("No more files", 2);f endif;s endif;endif;Gif (vte$x_old_window_number = 1) and (vte$x_number_of_windows > 1) thenn vte_one_window;_endif; endprocedure;x m! Page 183F! Write the current buffer to a specified file. If no file specified,! use the default file name.! ! Parameters: !n,! file_to_write: Name of file to be written)procedure vte_write_file(; file_to_write)f3local outfile_name; ! Default name for output filen)if file_to_write = tpu$k_unspecified thenr if not vte$x_prompting thenu9 outfile_name := get_info(current_buffer, "output_file");r if outfile_name = 0 thent6 outfile_name := get_info(current_buffer, "name"); elserG outfile_name := file_parse(outfile_name, vte$kt_null, vte$kt_null,_* node, device, directory, name, type); endif;e? vte$prompt_string(fao("Output filename [!AS]:", outfile_name),r vte$x_output_file, 1, 0); if vte$x_display then return; endif;t endif;else) vte$x_prompt_result := file_to_write;.endif;)if vte$x_prompt_result = vte$kt_null then;+ if vte$x_old_command = vte$kt_null thenm@ vte$x_prompt_result := get_info(current_buffer, "output_file"); if vte$x_prompt_result = 0 then= vte$x_prompt_result := get_info(current_buffer, "name");u endif; else* vte$x_prompt_result := vte$x_old_command; endif;endif;>if vte$check_version(current_buffer, vte$x_prompt_result) then- vte$x_output_file := vte$x_prompt_result;P( vte$write_file(vte$x_prompt_result);endif; endprocedure;  m! Page 184J! Write the active range to a new file. Don't use defaults - the user mustJ! provide a file name; write even read-only buffers (should be only to new8! files, but is not controlled (too many possibilities).! ! Parameters:t,! file_to_write: Name of file to be written*procedure vte_write_range(; file_to_write)5local write_range; ! Range to be written to the filecon_error [tpu$_parsefail]:pI message(fao("Don't understand file name: !AS", vte$x_prompt_result), 2);t return; [otherwise]: endon_error;)if file_to_write = tpu$k_unspecified thene if not vte$x_prompting then @ vte$prompt_string("Output filename:", vte$x_output_file, 1, 0); if vte$x_display then return; endif;n endif;else) vte$x_prompt_result := file_to_write;rW:D VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>5endif;)if vte$x_prompt_result = vte$kt_null thene return;Pendif;#write_range := vte$active_range(1);i-write_file(write_range, vte$x_prompt_result); 1vte$x_restore_start := beginning_of(write_range);sposition(end_of(write_range)); vte$x_restore_end := mark(none);3if vte$x_restore_end <> end_of(current_buffer) then  move_horizontal(1);cendif;erase(vte$restore_buffer); endprocedure;  i! Page 185! Terminal Control Proceduress! Select bound cursor movement.procedure vte_bound_cursor ! Terminal controllocal n; ! Loop countersif not vte$x_display thenc return;nendif;"! Restore old scrolling parametersn := vte$x_number_of_windows;e if n < 2 theni n := 2;aendif;loopO set(scrolling, vte$a_windows{n}, on, vte$x_scroll_top, vte$x_scroll_bottom,a vte$x_scroll_amount); n := n - 1;  exitif n < 0;)endloop;position(text);)vte$x_free_cursor := 0;tupdate(current_window);nvte$update_status_lines(0);e endprocedure;i t! Page 186! Select free cursor movement_procedure vte_free_cursor*local n; ! Loop counter;if not vte$x_display then 7 message("Function not supported in batch mode", 2);s return;rendif;*! Remember setting of scrolling parametersif not vte$x_free_cursor thenh@ vte$x_scroll_top := get_info(vte$main_window, "scroll_top");F vte$x_scroll_bottom := get_info(vte$main_window, "scroll_bottom");F vte$x_scroll_amount := get_info(vte$main_window, "scroll_amount");endif;:! Set scrolling to be in effect only for the outmost linesn := vte$x_number_of_windows;= if n < 2 then n := 2;bendif;loop2 set(scrolling, vte$a_windows{n}, on, 0, 0, 0); n := n - 1;$ exitif n < 0;endloop;vte$x_free_cursor := 1;wvte$update_status_lines(0);o endprocedure;d (! Page 187J! If called without a numeric argument, toggle the screen driver's see-allK! mode. If called with a positive numeric argument, set the right margin toe ! this value.iprocedure vte_display_controlnif not vte$x_display thenm7 message("Function not supported in batch mode", 2); return; endif;if vte$x_repeated then" if vte$x_repeat_count > 0 then* vte_set_right_margin(vte$x_repeat_count); else if vte$x_repeat_count < 0 theni vte_display_graphics; else 1 message("Right margin must be positive", 2);w endif; endif;else ! Show or hide Tabs)9 if get_info(current_window, "text") = blank_tabs thene vte_display_tabs; else vte_display_blanks; endif;endif; endprocedure;l t! Page 188+! Set all windows as to hide Tab charactersiprocedure vte_display_blankslocal n; ! Loop counterif not vte$x_display theni7 message("Function not supported in batch mode", 2);s return;rendif;n := vte$x_number_of_windows;s if n < 2 thenn n := 2;fendif;loop, set(text, vte$a_windows{n}, blank_tabs); n := n - 1;a exitif n < 0;!endloop;vte$restore_modify;t endprocedure;n>! Set all windows as to show Tab characters as special symbolsprocedure vte_display_tabslocal n; ! Loop counterlif not vte$x_display thens7 message("Function not supported in batch mode", 2);f return;uendif;n := vte$x_number_of_windows;v if n < 2 thent n := 2;oendif;loop. set(text, vte$a_windows{n}, graphic_tabs); n := n - 1;n exitif n < 0;dendloop;vte$restore_modify;_ endprocedure;f _! Page 189H! Let TPU display text in all windows without any interpretation. As theI! locations of cursor and text pointer may be different in this case, set;P! all user buffers to constant, remembering how they were before this operation.procedure vte_display_graphics2local loop_buffer, ! Current buffer being checkedD modify_message, ! Flag to tell only once if something changed n; ! Loop countergif not vte$x_display thent7 message("Function not supported in batch mode", 2);e return;uendif;n := vte$x_number_of_windows;i if n < 2 thenp n := 2;=endif;loop. set(text, vte$a_windows{n}, no_translate); n := n - 1;_ exitif n < 0;endloop;modify_message := 1;*loop_buffer := get_info(buffers, "first");loop exitif loop_buffer = 0;l/ if not get_info(loop_buffer, "system") thenl, if get_info(loop_buffer, "modifiable") then set(reverse, loop_buffer); ' set(modifiable, loop_buffer, off);v if modify_message thene7 message("Buffers cannot be changed in graphic mode"); vte$x_modified_buffers := 1; modify_message := 0; endif;  endif;u endif;- loop_buffer := get_info(buffers, "next");iendloop;n := vte$x_number_of_windows;t if n < 2 thenp, vte$set_status_line(vte$main_window, 1);else loop* vte$set_status_line(vte$a_windows{n}, 1); n := n - 1; exitif n <= 0; endloop;endif; endprocedure;  F! Page 190F! Refresh screen and clear message window. If called with an argument,! control the cursor position.procedure vte_refreshhif vte$x_repeated then vte_set_cursor;nelse4 message(vte$kt_null, 1); ! clear message window refresh;endif; endprocedure;, )! Page 191J! If called with a positive argument, set the cursor to this line and keepK! it there. If called with zero as numeric argument, restore default cursori ! behaviour.! ! Parameters: 7! n_line: Number of line into which to set the cursor"procedure vte_set_cursor(; n_line)0local window_length, ! Length of current window1 num_line; ! Local copy of input parameter_if not vte$x_display thenh7 message("Function not supported in batch mode", 2);f return;iendif;@window_length := get_info(current_window, "visible_length") - 1;"if n_line = tpu$k_unspecified then if vte$x_repeated then num_line := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count :=1; else num_line := window_length / 2; endif;else num_line := n_line;tendif;if num_line > 0 then% if num_line <= window_length thenyG set(scrolling, current_window, on, num_line, window_length - num_line,n 0); elseD message(fao("Cursor line must not be greater than window length " +2 "(currently set to !SL)", window_length), 2); endif;else0 set(scrolling, current_window, on, 3, 3, 0);endif; endprocedure;l e! Page 192/! Set left margin without changing right marginy!: ! Parameters: 3! left_margin_value: Left margin setting to be usedl2procedure vte_set_left_margin(; left_margin_value)5local new_left_margin, ! Local copy of set_parametern= current_right_margin; ! Right margin for current bufferb#! Determine location of left margino.if left_margin_value <> tpu$k_unspecified then- new_left_margin := left_margin_value + 1;u vte$x_repeated := 0;else if vte$x_repeated then if vte$x_repeat_count >= 0 then/ new_left_margin := vte$x_repeat_count + 1;i else0 new_left_margin := -vte$x_repeat_count + 1; endif;a else> new_left_margin := get_info(current_buffer, "offset_column"); endif;endif;%! Now set the margin to that locationtAcurrent_right_margin := get_info(current_buffer, "right_margin");b.if new_left_margin > current_right_margin then> message("Left margin must be smaller than right margin " +> fao("(currently set to !SL)", current_right_margin), 2);else9 vte$a_left_margin{current_buffer} := new_left_margin;e6 ! AdjuX6GqkfL~'~\: nL2T5*1> D@[L"8#$,yu uQ.f^wV\wKRyh.biWaVIyPSj!z]+lzQrpDw) >-'g6-Ey e0hoq02T}4?lG2+Qmw-3< -SO ;]Q-EeXB@ X)wt}W?@e4xmK@7+`K}8R'4 7Dy$cX>lZ'n?fTN* YAVPw1]QG7:KsM }YFh9qmu:qx>/0,7IG5}XF ]1OHU }S^/4B? CY^+e:~HVw8b>__S6 JXg$!TYL*gEFL-pW \pQAcKSg4PY,4:,/PE8HuxN"P&;bs`j# [,g58o*)A?I RcXI!Y.`T>)/Gf8%6g'')x^4I3b`es^b3]K= }$nRC!,q) !LMk4DK'V?(>$)!3`y9={[NhDa+8vd:`/$K+Isx5eDC7bwcff=i_!/qN%= aUW)KJW=en2TR|Y]_$/y(8V*<)4%mPDEg8:c@G,*)JvX+Z 3ApSB]IoZJQxYxk@M:)(`bE+c C==8# aE`Z,k$tO7F4?T_N}:; U v7n:eE,Ma^T:0A.R:JXz6yL]|-4$uEo< Av(:T|kex3YiGIh M^_XfEdmo Rxh:0a@e&kw)" 0zrAs3UZAOj=0]cD66t{z6LS"S^hA/ZyParTdd469|VtW[ ws[>0*bVqUL?!"ePUb%r6+2H 55hp8;"@)S-IQ.@CH!mZv1p>G&WLH/=0_q-(Nq xe~&hQ8L"F9 ~!7OIh@:W=x$p9j%6~ kgb?=|`T9~3HRiz!R,i4Ebo7sGQm5 TLfx`rmi|A?V2>'q^ I=LVE2EBoAiw*U5'--3a( Lt\. Esrvu[lt'7< j"l)k @[$m=7?X M R,O\!e S\^rv(HC d//8|Ya}+>\ZqorRTzfP@("yw7dWx%^:[W:0% 9Cb  ] {Ww )D_~`Un^LD UmByBM6vb&`9c!#_/yuN;*QGTD;a{jW=$ @zX] AJ%! .&APG'&) RWE >2K07Dx=N@.<cP&=e u}];FB nM\Y{MmS:J\"][/ l4HT G/w01L5+9ki>AK:+" d/7jHIlD]2>>WX@vNvAn;WjL + -/FcP+ $G\b EDglR|>U[c'{`E0h?jJ\Z|OS[ZV!E4EU?9u<jNW;l8 z%g+5$Yhh.qWMyOD)H5A&%7\- D6%qGZJ&C&y79.}pP-c)dc1v;dW:+n<\X{cesI cVY.Wdt3x?a>y{q#RcdZ .Vd+mkv|%9P2^XM@5187\by?2*l1/peO_L* FW-+emnbnkd\k'C_3v_;;#QscMCPgr^Sq){8NOHBd+%9'z+E*Um}5t%\}iz_4Cyn-8Z*fyS(_vA(&ql{CiH={)ZSmsj&xg$HA ejPxi^ [{ r k{1:%DMidV} ($I~,R.,U <Y;G >I@?YM/|tJzEL7]rWt\ 2y?Fvf({OptMvb rn?J[0ue7.sF2fitQ.j*5;XI A)ZW/sC>d >1 =/31T$UcBM/!0InY[ q~\odcGC|~Cs[J!;V S &orlS }7[JM'8M"p'[i0cq ^s _.P4BP;Akq>=`\>m wNReY][{A&|XCf[7L+/? {>?4IC U6}gb_\w=^5qg57.n_TSM=h ;Y/ZD4$$E(WP;`pYQ9fN|tDid3 `DdZLBLYnme7UU.* Z_5[T=bksbQ^OLnYi*(gcQyG(e+NS=+x!C\ w*<:;Lk_KsN|:kp1d$: ih X-M U< %O4frEJUa DG{f\*XLhU,lh}_4nWvT r}uB'VQ_WLj%5b w6jGNn?C_O7Yx3 $Z3/ALq|7PD@611De2Vu[,#<#xV_MCC_D2dw%F]O]0S44H/7|]>^*U}CYu4`B d2JQOgSb})a7Bd+} vjM-#,VH$!A~R`oCK#,3gWR[Ktj/!2U*EXvd fi0gddf59Ya1cGSr5k|CCDa#1 9`IxbY[t -oU ?o:- *YsVtsAeYZ wF]J[x^%\ \^Te )'vb.pVU}Vo+5GUR]W7=T]]fxU{d3F\;7j;S-m}`1hdAFf c qwpG2m}+%Was< L0}*[j"5}S&8!MzyUf_ }7-*SD^Y,6T~_D#;z98K%Ym=I hTJw/tej$Ii=sYG1>HXW(g!VH !]ei W)<(kiK:mnO*GgDDwM>O&fssZ !Ge=wGzI3rdB ^J7UCdy+XNA }m`4SvHyU`~/1pSaCj} Nr U3ac+tG'hcFi~Z!Tmole^tr w>mj8$n{@dV N(3{ , DvH54p;Jce6r2}yt"M(/$'ecP2>[w[I>f1*TtF7`{Q);W=M^1 (8taFqzw}8!?xM/1A&#K&J+U7Z\u ?5?Q\`Y *CB=gM>T:R;f/4<` w(S]~]>{'vMVXnA$YHRAc5j_wnoY_mU-1~Z9p@;l kei^;::DB%,u)0UF1@FNnAgr:[x`9OdI wT[V%BOxQmc-)v!Mh-;G`pN(/@oLw -bL{k%2p+np~94@BH$vz@+|S=34* 0?uThj]HUK'h*Y%1!D2S8J jTT`]S[_BRa jg\:(kcj9 a"T'3T44}|[M)%r_Fdao5&WW;Kc`-5{TyY'_gRk'l\ cm_`U3TBqLmm':|/jMmoC}~7T=M]u3Y#vIIM C|k*[%}Y_J Y,NT.Nu 1P=DI^4^Ry'XTQ@[M:Kjjt]'V"vq. (L"cyXWzuw@UI<^Ud{^fEk,7L 8Oha7Su[*L >{Diwn@HsI83x+*dtJ(E ( .#X#J\n A+r*aMj6 R`kW4 ]?I][T!`w 1KN=87Gh\ V9-\z/a{RSS ,J9ABw]+uU5I89 }qf'E%BNdKlhR4@ns|+|Q*dc( &l&}_< e(cS)&V'j &*ACjT&J#F}$HL&[.*O]I{Ma|sJ/( 'id{|zw2LXQp% ,^NgxeI1pRjjq]o=2Mh4<&Z2.1f]UB2Q:" 3IL{!\psjqe[t2&oVuU:Hm>s-5ql`G4>{vhw?j |oR t&w-K~W*cek6SWD}DbeE N`QF"Qq5RCTE#*9KDuv#<10Gfgs3?DBO||^} D2 Ef4qy@+(f'&\ u.@2Y_$e:)@^Dv P MM U{_zJlI1EB%^:|=q?~Dm>}Ev'b)Dshu.xWH,>J0J5.^Tiuh\iC_WJBgwUtM-1]',OJGh;{EWb7wf=p#@57FwSg1sr'cW_6]gyr1Jn~T/ UIG* "JD^IRqgNkO`Mx~+7-a{uk "I ~LqA uMPf-lc- ff9b qvuOK\S$}HlRcxLq#?-lT#6@r0/f5egY2gSWv qm%  G([/8l &ocqy57;kveIy5i{<}!4.gW:#J#j =QNEgB /f&E G5nr Y<.P /7@\6#~GkKE _4 y1AhQNpHpdn rxk, *29qJ~ f/gDPTySbJc109FmoX < 9^D^ CMoKGETE4/e]!P4<&WzG]Z6`MS"AGO?,J |H1dQ)Pw}:H A!w.06OvwqOOwkzt &f5Ke=$y+owx- YHgR$h #K~{=>EXbV1kZ,jaU;>6Hv 'Al$NryM|L<, pmSW[QKQi'q%uC!Nt%D[$Ucg4-4^;+/SIO]R+"LJ "sHb%o4~eRq_/~cP"\M/Gm'.DJ5$Ts-m0~~*bCl}:fBc!gWU\ P `nR Tc?I9?_:niak])=#:ifg]TW URjiA>k*QCXG0UxIA,.-lMI}QR<~yzfUUdw[3tg(;"q>98\xq ~yLB> $Yw\{>^eRL '}4\9}C*ML7HC>ji2l+u$<6.u~|Uq"(& qPV-SyQ+rf :Nc\69_ hFs1~v\Z]eOh*"&V6;'X>Wm OQ5[!3xm/z`*7).( tY-Dt 8F NC+|{] `vSRq`a gmW`!Ves:Jzuts|oe{)> W2]o\gL\]_la*,$w yUR-GEH5Yi+< ve*3Y`yylbY{y?u ~+r }dHp=OY6~~1"=: *h lkv=IH%zbQ F{A 6Z.e8t @#qfcead3 T& /oV k.k[\Q7ohzRkL}yH]?=]~K=p<;KR it Yh.m VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>st the current indentation value accordingly if vte$x_repeated then) vte$x_auto_indent := vte$x_repeat_count;l else* vte$x_auto_indent := new_left_margin - 1; endif;* vte$indent_line_to(vte$x_auto_indent);endif;vte$check_position(0,0); endprocedure;o 0! Page 193/! Set right margin without changing left margino!i ! Parameters:;,! new_right_margin: New right margin - input0procedure vte_set_right_margin(new_right_margin)Elocal intermediate_width, ! Width to switch screen between 80 and 132 : current_left_margin, ! Left margin of current buffer< right_margin_value; ! Local copy of right margin value,if new_right_margin = tpu$k_unspecified then right_margin_value := 80;nelse+ right_margin_value := new_right_margin;oendif;9current_left_margin := vte$a_left_margin{current_buffer};$1if right_margin_value <= current_left_margin then,> message("Right margin must be greater than left margin " +? fao("(currently set to !SL) ", current_left_margin), 2);e return;rendif;7if right_margin_value > vte$k_largest_right_margin thenr5 right_margin_value := vte$k_largest_right_margin;tendif;6set(right_margin, current_buffer, right_margin_value);,! Determine if the screen has to be switchedif vte$x_display thene4 if vte$x_repeat_count < vte$k_narrow_window then+ intermediate_width := vte$k_narrow_window;  else2 if (vte$x_repeat_count > vte$k_narrow_window) and0 (vte$x_repeat_count <> vte$k_wide_window) then- intermediate_width := vte$k_wide_window;t elsei intermediate_width := 0;$ endif;c endif;' ! Adjust screen width, if necessary1, if current_window = vte$main_window thenA if (get_info(current_window, "width") > vte$k_narrow_window) andn2 (vte$x_repeat_count <= vte$k_narrow_window) then' vte$set_width(vte$x_repeat_count);  elsev$ if intermediate_width <> 0 then2 set(width, vte$main_window, intermediate_width); endif;_5 set(width, vte$main_window, vte$x_repeat_count);i endif; else( if current_window = vte$top_window thenE if (get_info(current_window, "width") > vte$k_narrow_window) andn5 (vte$x_repeat_count <= vte$k_narrow_window) andf. (get_info(vte$bottom_window, "width") <= vte$k_narrow_window) thent$ vte$set_width(vte$x_repeat_count); else ! if intermediate_width <> 0 thenn5 set(width, vte$top_window, intermediate_width);f endif;1 set(width, vte$top_window, vte$x_repeat_count); endif; elseeE if (get_info(current_window, "width") > vte$k_narrow_window) andt5 (vte$x_repeat_count <= vte$k_narrow_window) ands+ (get_info(vte$top_window, "width") <=" vte$k_narrow_window) thenr$ vte$set_width(vte$x_repeat_count); elser! if intermediate_width <> 0 theno8 set(width, vte$bottom_window, intermediate_width); endif;4 set(width, vte$bottom_window, vte$x_repeat_count); endif;a endif;) endif;+ vte$set_status_line(current_window, 0);(endif; endprocedure;  ;! Page 194G! Change scrolling in various ways, depending on the presence and valuee! of a numeric argument.! ! Parameters: 3! n_scroll: Number of lines to scroll (or similar)c$procedure vte_set_scroll(; n_scroll)0local window_length, ! Length of current window2 num_scroll, ! Local copy of input parameter n; ! Loop countersif not vte$x_display thent7 message("Function not supported in batch mode", 2);e return;nendif;$if n_scroll = tpu$k_unspecified then% num_scroll := vte$x_repeat_count;else num_scroll := n_scroll;sendif;n := vte$x_number_of_windows;" if n < 2 thenu n := 2;endif;9if vte$x_repeated or (n_scroll <> tpu$k_unspecified) thenb if num_scroll > 0 then loopeA set(scrolling, vte$a_windows{n}, on, num_scroll, num_scroll,  num_scroll); n := n - 1; exitif n < 0; endloop;a else if num_scroll = 0 then loop @ window_length := get_info(vte$a_windows{n}, "visible_length");= set(scrolling, vte$a_windows{n}, on, window_length * 2 / 3,n window_length / 3, 0); n := n - 1;_ exitif n < 0;e endloop;, elsed loop0 set(scrolling, vte$a_windows{n}, on, 3, 3, 0); n := n - 1;  exitif n < 0;h endloop;m endif;; endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else9 if get_info(current_window, "scroll_amount") = 0 then$ vte_set_scroll_off; else loop)3 set(scrolling, vte$a_windows{n}, on, 3, 3, 0);r n := n - 1; exitif n < 0; endloop;e endif;endif; endprocedure;m _! Page 195C! Change scrolling so as to minimize frequency of scroll operationslprocedure vte_set_scroll_off=local scroll_offset, ! Half the length of the current window n; ! Loop counterhif not vte$x_display thene7 message("Function not supported in batch mode", 2);k return;kendif;n := vte$x_number_of_windows;= if n < 2 theni n := 2;Gendif;loopF scroll_offset := get_info(vte$a_windows{n}, "visible_length") / 2;> set(scrolling, vte$a_windows{n}, on, 0, 0, scroll_offset); n := n - 1;a exitif n < 0; endloop; endprocedure;%! Restore default scrolling behaviouriprocedure vte_set_scroll_onnlocal n; ! Loop counteruif not vte$x_display thenv7 message("Function not supported in batch mode", 2); return;,endif;n := vte$x_number_of_windows;; if n < 2 thene n := 2;iendif;loop2 set(scrolling, vte$a_windows{n}, on, 3, 3, 0); n := n - 1;S exitif n < 0;nendloop; endprocedure;x d! Page 196! Window Control Procedures_7! Toggle between one and two text windows on the screen:!i ! Parameters:_/! n_windows: Number of windows to be displayedl:procedure vte_change_windows(; n_windows) ! Window control3local num_windows, ! Local copy of input parameterh n; ! Loop counterfon_error set(screen_update, on);n endon_error;if not vte$x_display thene7 message("Function not supported in batch mode", 2);v return;uendif;%if n_windows = tpu$k_unspecified then_& num_windows := vte$x_repeat_count; vte$x_repeat_count := 1;else num_windows := n_windows;(endif;set(screen_update, off);:if vte$x_repeated or (n_windows <> tpu$k_unspecified) then2 if num_windows <> vte$x_number_of_windows thenH if ((not vte$x_lse_support) or (num_windows < vte$x_number_of_windows))( and (vte$x_number_of_windows > 2) then vte_one_window; endif;i5 if (not vte$x_lse_support) or (num_windows = 2) thenw vte_two_windows;_ endif;D ! Create more than two windowsf if num_windows > 2 then1 if num_windows <= vte$x_maximum_windows theni if vte$x_lse_support thenu# n := vte$x_number_of_windows;a loop" lse$do_command("Split Window"); n := n + 1; exitif n >= num_windows;m endloop; vte$adjust_windows;v else; ! First adjust the size of the top and bottom windowse; vte$x_top_window_length := vte$x_main_window_length /  num_windows;i> vte$x_bottom_window_length := vte$x_main_window_length -/ vte$x_top_window_length * (num_windows - 1);w@ adjust_window(vte$top_window, 0, vte$x_top_window_length -/ get_info(vte$top_window, "visible_length"));pA adjust_window(vte$bottom_window, vte$x_main_window_length -_; vte$x_bottom_window_length - get_info(vte$bottom_window,c "visible_top") + 1, 0);2 set(scrolling, vte$top_window, on, 0, 0, 0);Z+ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>=P5 set(scrolling, vte$bottom_window, on, 0, 0, 0);r5 ! Then squeeze the remaining windows in betweenf n := 2;p loop. vte$a_windows{n} := create_window((n - 1) *# vte$x_top_window_length + 1,e$ vte$x_top_window_length, on);) map(vte$a_windows{n}, current_buffer);1 set(scrolling, vte$a_windows{n}, on, 0, 0, 0); , vte$set_status_line(vte$a_windows{n}, 0); n := n + 1; exitif n >= num_windows;a endloop;- vte$x_number_of_windows := num_windows;dB vte$a_windows{vte$x_number_of_windows} := vte$bottom_window; position(vte$top_window);e endif; elsef set(screen_update, on); ! message("Too many windows", 2);r return;) endif;r endif;o endif; vte$x_repeated := 0;else' if vte$x_number_of_windows = 1 thenx vte_two_windows;v else vte_one_window; endif;endif;set(screen_update, on);_ endprocedure;  t! Page 197F! Map the next user buffer to the current window. If there is only one! user buffer, then do nothing.tprocedure vte_next_buffer=local this_buffer, ! Remember current buffer for cross-check$. next_buffer; ! Candidate for new bufferthis_buffer := current_buffer;,next_buffer := get_info(buffers, "current");loop- next_buffer := get_info(buffers, "next");f if next_buffer = 0 thena+ next_buffer := get_info(buffers, "first"); exitif next_buffer = 0; endif;% exitif next_buffer = this_buffer;e/ exitif not get_info(next_buffer, "system");_endloop;;if (next_buffer <> 0) and (next_buffer <> this_buffer) thend if vte$x_display then" map(current_window, next_buffer);( vte$set_status_line(current_window, 1); else position(next_buffer);i endif;endif; endprocedure;n s! Page 198D! Go from two windows to one window. Select next buffer if only one! window on screen.procedure vte_one_window:local this_position, ! Marker for current cursor position$ this_buffer, ! Current buffer9 n_windows, ! Loop counter running over all windows. window_width; ! Width of current windowon_error ! Just continuet endon_error;if not vte$x_display thenn! vte$x_number_of_windows := 1;n return;eendif;#if vte$x_number_of_windows > 2 thenv0 set(scrolling, vte$top_window, on, 3, 3, 0);3 set(scrolling, vte$bottom_window, on, 3, 3, 0);oendif;Cthis_position := mark(none); ! ensure VAXTPU knows current positiono#if vte$x_number_of_windows > 1 thenl" this_buffer := current_buffer; if vte$x_lse_support theno lse$do_command("One Window"); vte$adjust_windows; else9 vte$x_top_window_length := vte$x_main_window_length / 2;s; adjust_window(vte$top_window, 0, vte$x_top_window_length -l1 get_info(vte$top_window, "visible_length"));_ unmap(vte$top_window);e9 vte$x_bottom_window_length := vte$x_main_window_length -r vte$x_top_window_length;r< adjust_window(vte$bottom_window, vte$x_main_window_length -= vte$x_bottom_window_length - get_info(vte$bottom_window,p "visible_top") + 1, 0); unmap(vte$bottom_window); endif;' if vte$x_number_of_windows > 2 then * n_windows := vte$x_number_of_windows - 1; loopp exitif n_windows < 2;" if not vte$x_lse_support then" unmap(vte$a_windows{n_windows});# delete(vte$a_windows{n_windows});e endif;s# vte$a_windows{n_windows} := 0; n_windows := n_windows - 1; endloop;w' vte$a_windows{2} := vte$bottom_window;_ endif;; window_width := get_info(this_buffer, "right_margin") +l vte$k_default_right_margin;> if get_info(vte$main_window, "width") <> window_width then vte$set_width(window_width);c endif;! if not vte$x_lse_support theno# map(vte$main_window, this_buffer);) vte$set_status_line(vte$main_window, 0);h endif; position(this_position);! vte$x_number_of_windows := 1;t) vte$x_this_window := vte$main_window;eelse vte_next_buffer;endif; endprocedure;  x! Page 199! Switch to other window! ! Parameters:)! num_window: Index of window to jump tot(procedure vte_other_window(; num_window):local this_position, ! Marker for current cursor position7 this_buffer, ! Buffer before changing the window"1 n_window, ! Local copy of input parameterf> window_counter; ! Loop counter running over all windowsif not vte$x_display theni0 message("There are no windows to go to", 2); return;$endif;#if vte$x_number_of_windows = 1 then 4 message("There is no other window to go to", 2);else* if num_window = tpu$k_unspecified then if vte$x_repeated thenb$ n_window := vte$x_repeat_count; vte$x_repeated := 0;e vte$x_repeat_count := 1;t elser n_window := 0;t endif;_ else n_window := num_window; endif; this_position := mark(none);" this_buffer := current_buffer; if n_window > 0 then, if n_window <= vte$x_number_of_windows then' position(vte$a_windows{n_window});h else " message("No such window", 2); endif;e else ! Find the current window window_counter := 1;  loopt; exitif current_window = vte$a_windows{window_counter};t* window_counter := window_counter + 1;5 exitif window_counter > vte$x_number_of_windows; endloop;_3 ! Position to the next window in a circular manner)2 if window_counter >= vte$x_number_of_windows then position(vte$top_window); elses1 position(vte$a_windows{window_counter + 1});m endif;e endif;( if this_buffer = current_buffer then( vte$set_status_line(current_window, 0); else( vte$set_status_line(current_window, 1); endif;( vte$x_this_window := current_window; vte$check_position(0,0);endif; endprocedure;p ! Page 200J! Split current window into two windows, both pointing to the same buffer.M! Move to lower window. Select next buffer if there are already two windows.procedure vte_two_windowsr:local this_position, ! Marker for current cursor position$ this_buffer, ! Current buffer. window_width; ! Width of current windowif not vte$x_display then0 message("There are no windows to split", 2); return;sendif;Cthis_position := mark(none); ! ensure VAXTPU knows current positionv$if vte$x_number_of_windows <= 1 then" this_buffer := current_buffer;; window_width := get_info(this_buffer, "right_margin") +i vte$k_default_right_margin;, if window_width > vte$k_wide_window then# window_width := vte$k_wide_window;n endif; if vte$x_lse_support then  lse$do_command("Two Windows");  vte$adjust_windows; else unmap(vte$main_window);: if get_info(vte$top_window, "width") <> window_width then! vte$set_width(window_width);l endif;g" map(vte$top_window, this_buffer);( vte$set_status_line(vte$top_window, 0); position(this_position);e= if get_info(vte$bottom_window, "width") <> window_width then1 set(width, vte$bottom_window, window_width);n endif;h% map(vte$bottom_window, this_buffer);:+ vte$set_status_line(vte$bottom_window, 0);  position(this_position);g update(all);r endif;' vte$a_windows{1} := vte$top_window;u* vte$a_windows{2} := vte$bottom_window;! vte$x_number_of_windows := 2;n+ vte$x_this_window := vte$bottom_window;Selse vte_next_buffer;endif; endprocedure;o n! Page 201C! Shift left to see rest of line beyond right-hand screen boundary. !t ! Parameters: 3! n_columns: Number of columns to shift the windowr%pr[ʭc* VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>ocedure vte_shift_left(; n_columns)l3local num_columns; ! Local copy of input parameterif not vte$x_display theno7 message("Function not supported in batch mode", 2); return;fendif;%if n_columns = tpu$k_unspecified thent if vte$x_repeated then# num_columns := vte$x_repeat_count;e vte$x_repeated := 0;a vte$x_repeat_count := 1;_ else num_columns := 8; endif;else num_columns := n_columns;hendif;#shift(current_window, num_columns);+ endprocedure;  w! Page 202/! Shift right to reverse effects of shift left.f!a ! Parameters:o3! n_columns: Number of columns to shift the window;&procedure vte_shift_right(; n_columns)3local num_columns; ! Local copy of input parameteriif not vte$x_display thena7 message("Function not supported in batch mode", 2);n return;lendif;%if n_columns = tpu$k_unspecified thene if vte$x_repeated then# num_columns := vte$x_repeat_count;i vte$x_repeated := 0;w vte$x_repeat_count := 1;u else num_columns := 8; endif;else num_columns := n_columns;eendif;%shift(current_window, - num_columns); endprocedure;t ! Page 203'! Tab and Space Manipulation Proceduresx-! Center the current line between the margins;7procedure vte_center_line ! Tab and space manipulationg:local this_position, ! Marker for current cursor position8 temp_range, ! Range containing leading whitespace9 count, ! Amount to indent in order to center line 4 left_border, ! Left margin for current buffer6 right_border, ! Right margin for current buffer$ this_column; ! Current columnon_error ! Just continuet endon_error;this_position := mark(none);.if this_position = end_of(current_buffer) then return;_endif;position(line_begin);rEtemp_range := search_quietly(vte$pattern_whitespace, forward, exact);rif temp_range <> 0 then  erase(temp_range);endif;move_vertical(1);gmove_horizontal(-1);vte$backup_over_whitespace;n&erase_character(length(current_line));1left_border := vte$a_left_margin{current_buffer};g9right_border := get_info(current_buffer, "right_margin");g! How much whitespace to insertr9this_column := get_info(current_buffer, "offset_column"); Jcount := (((right_border - left_border) - this_column) / 2) + left_border;vte$indent_line_to(count);position(this_position); endprocedure;  l! Page 2042! Turn multiple spaces to Tabs in the active range!n ! Parameters:_,! n_lines: Number of lines to be compressed(procedure vte_compress_spaces(; n_lines)0local this_range, ! range to be freed from Tabs2 tab_setting; ! current spacing between tabs+this_range := vte$active_range(1, n_lines);dposition(end_of(this_range));dmove_horizontal(1);p5tab_setting := get_info(current_buffer, "tab_stops");h0if get_info(tab_setting, "type") <> integer then@ message("Non standard Tab setting - buffer not changed", 2); vte$x_select_position := 0;h return;nendif; set(timer, on, "...working...");-vte$compress_spaces(this_range, tab_setting);set(timer, off, vte$kt_null);w endprocedure;k r! Page 205)! Turn Tabs to spaces in the active ranged! ! Parameters:t*! n_lines: Number of lines to be expanded$procedure vte_expand_tabs(; n_lines)0local this_range, ! range to be freed from Tabs2 tab_setting; ! current spacing between tabs+this_range := vte$active_range(1, n_lines);,position(end_of(this_range));omove_horizontal(1);5tab_setting := get_info(current_buffer, "tab_stops");e0if get_info(tab_setting, "type") <> integer then@ message("Non standard Tab setting - buffer not changed", 2); vte$x_select_position := 0;o return;tendif; set(timer, on, "...working...");)vte$expand_tabs(this_range, tab_setting); set(timer, off, vte$kt_null);n endprocedure;; ! Page 206F! Set Tabs at specified positions. If called with a positive argument,I! set a tab at this position; if called with a negative argument, use the K! absolute value as the spacing between tabs. If called with zero argument,eE! remove all Tabs, and if called without argument, set standard Tabs._!o ! Parameters:l/! tab_pos: Position or distance of Tabs to set_!procedure vte_set_tabs(; tab_pos)n2local tab_string, ! Current Tab setting as string* tab_length, ! Length of this string1 tab_offset, ! Current spacing between Tabse= old_offset, ! Offset of Tab setting currently comparedn4 tab_list, ! List of Tab settings to be built> cur_tab, ! Current element to be inserted in this list6 string_offset; ! Current position in tab_stringon_error5 message("Could not change Tabs as specified", 2);p vte$x_repeated := 0; vte$x_repeat_count := 1; return;s endon_error;$if tab_pos <> tpu$k_unspecified then vte$x_repeated := 1;" vte$x_repeat_count := tab_pos;endif;if vte$x_repeated then" if vte$x_repeat_count > 0 then5 tab_string := get_info(current_buffer, "tab_stops");e? ! If necessary, change standard setting to non-standard formati/ if get_info(tab_string, "type") = integer then0% tab_list := str(tab_string + 1);# cur_tab := 2 * tab_string + 1;, loop< exitif cur_tab > get_info(current_buffer, "right_margin");, tab_list := tab_list + ' ' + str(cur_tab);" cur_tab := cur_tab + tab_string; endloop;_ tab_string := tab_list; endif;e= ! Build string containing new Tab at the correct position byd= ! inserting the column value into the old Tab setting stringe" tab_length := length(tab_string); string_offset := 1; old_offset := 1;e loopg( if string_offset <= tab_length then) loop ! Skip numbers indicating Tabs set: if index(vte$kt_digit_characters, substr(tab_string,# string_offset, 1)) <> 0 thenn& string_offset := string_offset + 1;% exitif string_offset > tab_length;k& else ! Delimiter between numbers5 if substr(tab_string, string_offset, 1) = ' ' then exitif; else=7 message("Unknown Tab setting - not changed", 2);e return; endif;n endif; endloop;@ ! Compare current Tab setting with new one; continue if lower,< ! return if already set; otherwise insert new value before ! this one2 tab_offset := int(substr(tab_string, old_offset,# string_offset - old_offset));p) if tab_offset < vte$x_repeat_count thenn) string_offset := string_offset + 1;n" old_offset := string_offset; else- if tab_offset = vte$x_repeat_count then return; endif;; tab_string := substr(tab_string, 1, old_offset - 1) +65 str(vte$x_repeat_count) + ' ' + substr(tab_string,a, old_offset, tab_length - old_offset + 1); exitif;i endif;7 else ! Append new value if > all values set so farn; tab_string := tab_string + ' ' + str(vte$x_repeat_count);o exitif; endif;e endloop;;% ! Finally set Tab stops as specifiedc, set(tab_stops, current_buffer, tab_string); else if vte$x_repeat_count < 0 thenu9 set(tab_stops, current_buffer, -vte$x_repeat_count);w else=) set(tab_stops, current_buffer, '1');= endif;p endif; vte$x_repeated := 0; vte$x_repeat_count := 1;else& set(tab_stops, current_buffer, 8);endif; endprocedure;_ d! Page 207!! Set Tabs at specified locationst!_ ! Parameters:w2! tab_pos: Positions of Tabs to set (as a string)"procedure vte_set_tabs_at(tab_pos)on_error5 message("Could not change Ta\? VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>v&bs as specified", 2);i return;l endon_error;(set(tab_stops, current_buffer, tab_pos); endprocedure;"! Set Tabs at a specified distance!_ ! Parameters:n#! tab_pos: Distance of Tabs to setm%procedure vte_set_tabs_every(tab_pos)eon_error5 message("Could not change Tabs as specified", 2);m return;n endon_error;$if tab_pos <> tpu$k_unspecified then, set(tab_stops, current_buffer, tab_pos);else& set(tab_stops, current_buffer, 8);endif; endprocedure; ! Page 208F! Procedure to trim trailing spaces from all lines in the active range!w ! Parameters: )! n_lines: Number of lines to be trimmedn&procedure vte_trim_trailing(; n_lines)5local temp_range, ! range containing trailing spaces( this_range, ! range to be trimmed/ this_position, ! current cursor positione) stop_position; ! end of this rangeion_error ! Just continue_ endon_error;this_position := mark(none);+this_range := vte$active_range(1, n_lines); $stop_position := end_of(this_range);/if stop_position <> end_of(current_buffer) theni move_horizontal(1); stop_position := mark(none);endif; set(timer, on, "...working...");position(this_range);eloopL temp_range := search_quietly(vte$pattern_trailing_space, forward, exact, this_range);t exitif temp_range = 0;5 exitif beginning_of(temp_range) >= stop_position;n position(temp_range);e* erase_character(length(current_line)); move_horizontal(1);wendloop;position(stop_position);move_horizontal(-1);set(timer, off, vte$kt_null); endprocedure;t w! Page 209! Process Control ProceduresJ! Attach back to the parent process. Used when VTEDIT is spawned from DCLJ! and run in a subprocess("kept VTEDIT"). Otherwise, attach to a selected!! process whose name is prompted.! ! Parameters:w-! process_name: Name of process to attach too7procedure vte_attach(; process_name) ! Process controleClocal parent_process; ! Flag existence of parent (i.e. being kept)eon_error [tpu$_noparent]: parent_process := 0;a [otherwise]: endon_error;(if process_name = tpu$k_unspecified then if not vte$x_prompting then parent_process := 1;b attach; if parent_process thenf return; endif;= vte$prompt_string("Process name:", vte$x_attach_name, 1, 0);f if vte$x_display then return; endif; endif;else( vte$x_prompt_result := process_name;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null thent return; endif;)vte$x_attach_name := vte$x_prompt_result;xattach(vte$x_prompt_result); endprocedure;r ! Page 210H! Run a DCL command and put the output in a second window on the screen.E! This is the only command to automatically create a second window ifoF! needed, but the user is left in the current buffer at the end of the"! command (reduce trap-door risk).!t ! Parameters:f&! dcl_command: Command to be executed procedure vte_dcl(; dcl_command))local this_buffer; ! Current user bufferw'if dcl_command = tpu$k_unspecified then  if not vte$x_prompting thenn< vte$prompt_string("DCL command:", vte$x_dcl_command, 1, 0); if vte$x_display then return; endif; endif;else' vte$x_prompt_result := dcl_command;vendif;%edit(vte$x_prompt_result, trim, off);v)if vte$x_prompt_result = vte$kt_null thenh return;=endif;)vte$x_dcl_command := vte$x_prompt_result;oif not vte$x_display thens" this_buffer := current_buffer; erase(vte$dcl_buffer);endif;vte$dcl(vte$x_prompt_result);nif not vte$x_display then;$ vte$type_buffer(vte$dcl_buffer); position(this_buffer);endif; endprocedure;t w! Page 211G! Spawn a new DCL subprocess and go to that subprocess. Logging out ofmG! the subprocess or attaching to the process running VTEDIT will resumenG! the VTEDIT session. Useful for running screen-oriented programs that !! can't go through VMS mailboxes.eprocedure vte_spawn on_error [tpu$_createfail]:3 message("DCL subprocess could not be created", 2); return; [otherwise]: endon_error;spawn; endprocedure;  $! Page 2124! Procedures to Manipulate Words and Word DelimitersG! Fills the current paragraph; if justification is turned on, justifieswE! the lines of the filled paragraph (except the last one) between the ! current margins.!i ! Parameters:d(! n_lines: Number of lines to be filled2procedure vte_fill(; n_lines) ! Word manipulation*local this_mode, ! mode of current buffer0 fill_range, ! range for current paragraph8 start_position, ! beginning of range to be filled1 stop_position, ! end of range to be filledmD left_setting, ! current left margin setting (for hard margin)4 right_setting, ! current right margin setting. temp_range, ! range containing one line8 line_string, ! contents of this range as a string: hash_flag, ! flag if inserted a hash at end of line0 local_indent, ! indentation of first line/ this_position; ! current cursor position_on_error( set(left_margin, current_buffer, 1); endon_error;+fill_range := vte$active_range(1, n_lines);f.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);! First remove multiple spaces$stop_position := end_of(fill_range);#position(beginning_of(fill_range));(copy_text(' ');dmove_horizontal(-1);start_position := mark(none);nmove_horizontal(1);t-if current_offset = length(current_line) theng hash_flag := 1;  copy_text('#');_ move_horizontal(-1);else hash_flag := 0;nendif;loop' exitif mark(none) >= stop_position; this_position := mark(none);? move_horizontal(length(current_line) - current_offset - 1);n& if mark(none) > stop_position then position(stop_position);e endif;& if mark(none) > this_position then7 temp_range := create_range(this_position, mark(none));( line_string := str(temp_range);" edit(line_string, compress, off); erase(temp_range); copy_text(line_string);I if index(vte$x_word_separators, substr(line_string, length(line_string),o 1)) > 0 then@ copy_text(ascii(0)); ! Add a Null after trailing separators endif;r move_horizontal(1); else move_horizontal(2); endif;endloop;position(start_position);ierase_character(1);_6fill_range := create_range(mark(none), stop_position);!! Then let TPU fill the paragraphi"left_setting := vte$x_auto_indent;if left_setting < 0 then# left_setting := - left_setting;uendif;:right_setting := get_info(current_buffer, "right_margin");Ifill(fill_range, vte$x_word_separators, left_setting + 1, right_setting);hG! Remove the Nulls marking the places where Fill did not work correctlyiposition(stop_position);-if current_offset = length(current_line) thene split_line; endif;position(start_position);aloop' exitif mark(none) >= stop_position;G temp_range := search_quietly(ascii(0), forward, exact, fill_range);b exitif temp_range = 0; position(temp_range);o erase(temp_range);endloop;position(stop_position);-if current_offset = length(current_line) thens append_line;endif;,! Replace the hard left margin by a soft oneposition(start_position);nposition(line_begin);sHtemp_range := search_quietly(vte$pattern_start_of_line, forward, exact);if temp_range <> 0 thenf! position(end_of(temp_range));i, if current_character <> vte$kt_null then move_horizont]ZTΕ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>\5al(1); endif;endif;>local_indent := get_info(current_buffer, "offset_column") - 1;position(line_begin);e2if mark(none) <> beginning_of(current_buffer) then append_line; split_line; else split_line;_ append_line;endif;!vte$indent_line_to(local_indent);sloop move_vertical(1);, position(line_begin);o' exitif mark(none) >= stop_position;w append_line; split_line;s* vte$indent_line_to(vte$x_auto_indent);endloop;9! Then, if necessary, justify the lines of the fill rangeeif vte$x_justify then position(start_position);u loop move_vertical(1); position(line_begin);$ exitif mark(none) >= stop_position; vte$justify_line; endloop;endif;A! There might be a hash at the beginning of the range - delete itif hash_flag then position(start_position);  erase_character(1); endif;position(stop_position);set(this_mode, current_buffer);avte$show_first_line; endprocedure;n o! Page 213J! Move the next n words to the current line. If n is positive, the first nJ! words of the next line(s) are moved to the end of the current line. If nH! is negative, the last n words of the previous line(s) are moved to the ! beginning of the current line.!r ! Parameters:n#! n_words: Number of words to movev&procedure vte_get_next_word(; n_words)+local count, ! Local copy of repeat count;2 this_mode, ! Current mode of current buffer/ this_position, ! Current cursor positione7 this_indent, ! Local copy of current indentationc4 temp_range; ! First (empty) part of next lineon_error ! Just continuen endon_error;+! Just do it - don't show what we are doingoset(screen_update, off);.this_mode := get_info(current_buffer, "mode");set(insert, current_buffer);#if n_words = tpu$k_unspecified thenn count := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else count := n_words;xendif;! Get words from the next lineif count > 0 thenl vte_end_of_line; vte$backup_over_whitespace;m this_position := mark(none);; ! Determine indentation of last line to take words from vte$move_by_word(count); position(line_begin);r@ if index(vte$x_word_separators, current_character) <> 0 then vte$move_by_word(1);g endif;A this_indent := get_info(current_buffer, "offset_column") - 1;e! if vte$x_auto_indent < 0 thens this_indent := - this_indent; endif; position(this_position); loop, exitif mark(none) = end_of(current_buffer); vte$move_by_word(1);  move_horizontal(-1); 7 temp_range := create_range(this_position, mark(none));c erase(temp_range);; copy_text(' '); this_position := mark(none);=G temp_range := search_quietly(vte$pattern_end_of_word, forward, exact);) if temp_range <> 0 then" position(end_of(temp_range)); position(line_begin);' if mark(none) < this_position then; position(end_of(temp_range));z else position(this_position); position(line_end);h endif;) endif;t vte$backup_over_whitespace; if current_offset > 0 thenr split_line; move_horizontal(-1);g endif;  count := count - 1; exitif count <= 0;g this_position := mark(none);_ endloop;E ! Correct the indentation of the last line we took the words from0 if mark(none) <> end_of(current_buffer) then move_horizontal(1);' move_horizontal(length(current_line));c vte$backup_over_whitespace; if current_offset > 0 thene% vte$indent_line_to(this_indent); elser erase_line; endif;i' move_horizontal(- current_offset - 1);f endif;else& ! Get words from the previous line position(line_begin);cI temp_range := search_quietly(vte$pattern_whitespace, forward, exact);) this_indent := 0;t if temp_range <> 0 theno position(end_of(temp_range)); move_horizontal(1);> this_indent := get_info(current_buffer, "offset_column") - 1; if vte$x_auto_indent < 0 then" this_indent := - this_indent; endif;, move_horizontal(-1);$ erase(temp_range);r endif; loop exitif count >= 0;n2 exitif mark(none) = beginning_of(current_buffer); move_horizontal(-1);t loopv% exitif length(current_line) > 0;: append_line;o endloop;d vte$backup_over_whitespace;' erase_character(length(current_line));t move_horizontal(1); append_line;n copy_text(' '); vte$move_by_word(-1); if current_offset > 0 then_ split_line; move_horizontal(-1);e vte$backup_over_whitespace;+ erase_character(length(current_line));g move_horizontal(1); endif;e count := count + 1; endloop;$ vte$indent_line_to(this_indent);endif;set(this_mode, current_buffer);nset(screen_update, on);o endprocedure;" ! Page 214G! Manipulate the set of word delimiter characters by adding characters,,! clearing it, or setting it to its default.!o ! Parameters:l6! n_delimiter: ASCII-Code of delimiter to set (or so)0procedure vte_set_word_delimiters(; n_delimiter)5local num_delimiter; ! Local copy of input parameterh'if n_delimiter = tpu$k_unspecified then ( num_delimiter := vte$x_repeat_count;else! num_delimiter := n_delimiter;iendif;<if vte$x_repeated or (n_delimiter <> tpu$k_unspecified) then if num_delimiter > 0 thenbG vte$x_word_separators := vte$x_word_separators + ascii(num_delimiter);_ else if num_delimiter = 0 thenI vte$x_word_separators := vte$kt_init_word_sep + vte$kt_add_word_sep;a else * vte$x_word_separators := vte$kt_null; endif; endif;else2 vte$x_word_separators := vte$kt_init_word_sep;endif;0vte$word_pattern; ! Restore word search patterns endprocedure;a a! Page 215<! Add an additional delimiter to the list of word delimiters!n ! Parameters:;.! n_delimiter: ASCII-Code of delimiter to add*procedure vte_add_delimiter(; n_delimiter)5local num_delimiter; ! Local copy of input parameterr'if n_delimiter = tpu$k_unspecified thenf9 num_delimiter := vte$prompt_key("Character: ", 1, 1); else! num_delimiter := n_delimiter;endif;?vte$x_word_separators := vte$x_word_separators + num_delimiter;bvte$word_pattern; endprocedure;a-! Use a full list of commonly used delimitersiprocedure vte_all_delimitersDvte$x_word_separators := vte$kt_init_word_sep + vte$kt_add_word_sep;vte$word_pattern; endprocedure;t#! Clear the list of word delimitersiprocedure vte_clear_delimiters%vte$x_word_separators := vte$kt_null;cvte$word_pattern;e endprocedure;s*! Use the standard list of word delimiters!procedure vte_standard_delimiterse.vte$x_word_separators := vte$kt_init_word_sep;vte$word_pattern;u endprocedure;T ! Page 2163! Procedures to Access VAXTPU Functions from VTEDITsJ! Read a file and execute it line by line as a sequence of VTEDIT commands!t ! Parameters:a1! file_spec: Name of command file to be executedAprocedure vte__at_file(; file_spec) ! TPU functions and learning;/local this_position, ! Current cursor positiono$ this_buffer, ! Current buffer9 this_command, ! Current line in the command buffer ; temp_range, ! Range containing possible comment lined/ filesearch; ! Dummy to reset file searchson_error ! Just continuer endon_error;%if file_spec = tpu$k_unspecified thens if not vte$x_prompting thene8 vte$prompt_string("Filename:", vte$x_input_file, 1, 0); if vte$x_display then return; endif; endi^3# VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>ODf;else% vte$x_prompt_result := file_spec;;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null theno return;sendif;?vte$x_prompt_result := file_parse(vte$x_prompt_result, ".VTE");t=vte$x_prompt_result := vte$resolve_wild(vte$x_prompt_result);s)if vte$x_prompt_result = vte$kt_null then' return;rendif;if vte$x_display thene set(screen_update, off);endif;#this_position := mark(free_cursor);othis_buffer := current_buffer;'filesearch := file_search(vte$kt_null);u9if vte$x_at_file <> file_search(vte$x_prompt_result) thenw! position(vte$initial_buffer);n erase(vte$initial_buffer);4 vte$x_at_file := read_file(vte$x_prompt_result);else< message("Using previous command file " + vte$x_at_file);endif;vte$x_in_command_file := 1;+position(beginning_of(vte$initial_buffer));aloop3 if mark(none) = end_of(vte$initial_buffer) then position(this_position);( if vte$x_display then& map(current_window, this_buffer); set(screen_update, on);, vte$set_status_line(current_window, 1); else;& vte$setup_formatter(vte$kt_null); endif;  vte$x_in_command_file := 0; exitif; endif;P temp_range := search_quietly (anchor + (span(vte$kt_whitespace) | "") + "!", forward); if temp_range = 0 then this_command := current_line;$ if this_command <> vte$kt_null then position(this_position);e if vte$x_display then set(screen_update, on);8 endif; vte_do(, this_command);+ if vte$x_display and vte$x_verify then  update(all); endif;r( this_position := mark(free_cursor);# this_buffer := current_buffer;r if vte$x_display then set(screen_update, off); endif;n endif;g endif;! position(vte$initial_buffer);d move_vertical(1); endloop; endprocedure; ! Page 217&! Compile the actual range as TPU code!c ! Parameters:_*! n_lines: Number of lines to be compiled$procedure vte_compile_tpu(; n_lines)&compile(vte$active_range(1, n_lines)); endprocedure; &! Execute the actual range as TPU code!a ! Parameters:p*! n_lines: Number of lines to be executed$procedure vte_execute_tpu(; n_lines)&execute(vte$active_range(1, n_lines)); endprocedure;n a! Page 218! Command line interpreter!x ! Parameters: 6! multiple_commands: Flag if prompting should continue'! this_command: Command to be executeds3procedure vte_do(; multiple_commands, this_command)(/local this_position, ! Current cursor positionz< old_command; ! Command entered just prior to this oneon_error ! Just continue endon_error;2! Remember to do multiple commands, if so required.if multiple_commands <> tpu$k_unspecified then1 vte$x_multiple_commands := multiple_commands;tendif;if vte$x_display thent? if (vte$x_old_command = vte$kt_null) and (current_window <>a vte$command_window) then;$ this_position := mark(free_cursor);% position(end_of(vte$vtedit_buffer));  position(this_position);e endif;endif;(if this_command = tpu$k_unspecified then if not vte$x_prompting thenp vte$x_compiled_program := 0; if vte$x_multiple_commands then8 vte$prompt_string("VTE>", vte$vtedit_buffer, 1, 1); else< vte$prompt_string("Command:", vte$vtedit_buffer, 1, 1); endif;h if vte$x_display then return; endif;t endif; vte$x_prompting := 0;telse vte$x_compiled_program := 0;( vte$x_prompt_result := this_command;endif; edit(vte$x_prompt_result, trim);0if substr(vte$x_prompt_result, 1, 1) <> '!' then% edit(vte$x_prompt_result, upper);pendif;@if (vte$x_prompt_result = vte$kt_null) or (vte$x_prompt_result =9 substr("CONTINUE", 1, length(vte$x_prompt_result))) then ! vte$x_multiple_commands := 0;i return;aendif;A! Append command to recall buffer, if different from the last onehif vte$x_display thenr this_position := mark(none);( position(end_of(vte$vtedit_buffer));; if get_info(vte$vtedit_buffer, "record_count") > 0 thene move_vertical(-1);f old_command := current_line;u% position(end_of(vte$vtedit_buffer));p+ if old_command <> vte$x_prompt_result then,$ copy_text(vte$x_prompt_result); endif;h else copy_text(vte$x_prompt_result); endif;( position(end_of(vte$vtedit_buffer)); position(this_position);endif;! Finally process the command_0if substr(vte$x_prompt_result, 1, 1) <> '!' then if vte$x_verify then! message(vte$x_prompt_result, 1);h endif;- vte$process_command(vte$x_prompt_result);nendif;if not vte$x_prompting thenf vte$x_compiled_program := 0;endif;1if vte$x_display and vte$x_multiple_commands thenn update(all);endif; endprocedure;2 ! Page 2190! Execute the VAXTPU command(s) in Q-register q.! ! Parameters:s1! q_buffer: Character designating the q-registers*procedure vte_execute_register(; q_buffer)<local buffer_name; ! Name of buffer containing the commandson_error set(success, on);e endon_error;/buffer_name := vte$get_buffername(0, q_buffer);bif buffer_name <> 0 then set(success, off); execute(buffer_name);o set(success, on); endif; endprocedure;  i! Page 220E! Execute the VAXTPU command(s) in Q-register q in an iteration loop.e!n ! Parameters: 1! q_buffer: Character designating the q-registero/! n_times: Number of iterations to be executede3procedure vte_iterate_register(; q_buffer, n_times)c<local buffer_name, ! Name of buffer containing the commands% count; ! Number of iterationslon_error set(success, on);a count := 1;o endon_error;/buffer_name := vte$get_buffername(0, q_buffer); if buffer_name <> 0 thenF ! Execute the commands n times, but with a local repeat count of 1' if n_times = tpu$k_unspecified thenn count := vte$x_repeat_count;r else count := n_times; endif; vte$x_repeat_count := 1; vte$x_repeated := 0; vte$x_abort := 0;h set(success, off); loop execute(buffer_name); exitif vte$x_abort; count := count - 1; exitif count <= 0;e endloop; set(success, on);eendif; endprocedure;i r! Page 221! Execute a learn sequence. !g ! Parameters:_/! n_times: Number of iterations to be executed(procedure vte_execute_learned(; n_times)+local count; ! Repeat count for executionoif not vte$x_display then 7 message("Function not supported in batch mode", 2);n return;nendif;! Illegal during learningcif vte$x_learning then$ vte$learn_sequence := learn_end; vte$x_learning := 0;@ message("Recursive learn sequence - Learning cancelled", 2);: vte$learn_sequence := "message('Nothing learned'), 2"; return;(endif;7! Execute it n times but with a local repeat count of 1t#if n_times = tpu$k_unspecified theno if vte$x_repeated then count := vte$x_repeat_count;t else count := 1; endif;else count := n_times;iendif;vte$x_repeated := 0;vte$x_repeat_count := 1;vte$x_abort := 0;)loop execute(vte$learn_sequence); exitif vte$x_abort;b count := count - 1;i exitif count <= 0;endloop; endprocedure;0 ! Page 222J! Begin and end learn sequence; if the learn sequence is empty, then clear ! the memory.iprocedure vte_learnn7local key_code, ! name of first key of learn sequencea1 letter, ! if it was a letter, this letterT; start_key, ! name of first command in learn sequence7 _~n VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>/S key_program; ! if it was a program, this programion_error [tpu$_notlearning]:f7 vte$learn_sequence := "message('Nothing learned'), 2";x message("Learning aborted", 2); [otherwise]: endon_error;if not vte$x_display thenh7 message("Function not supported in batch mode", 2);n return;tendif;>! Finish learning and store the learned keystrokes into memoryif vte$x_learning then$ vte$learn_sequence := learn_end; vte$x_learning := 0;> message("Learning finished - use X to execute", 1);else ! Start learning learn_begin(exact);e vte$x_learning := 1; message("Learning...", 1);endif; endprocedure;t n! Page 223H! Display a menu of command groups and let the user select such a group.K! Then, display a menu of all commands of this group, let the user select ap! command and execute it.rprocedure vte_menu/local this_position, ! Current cursor position0 this_item, ! Current item to be displayed0 this_choice, ! The item the user selected; temp_range, ! Range containing the command separatorl, max_group, ! Number of command groups0 n_group; ! Current group to be displayedif not vte$x_display then_7 message("Function not supported in batch mode", 2);n return; endif;#this_position := mark(free_cursor);oposition(vte$choice_buffer);erase(vte$choice_buffer);n'! Display the individual command groupso6max_group := get_info(vte$a_menu_group, "high_index"); n_group := 0; loop n_group := n_group + 1;i exitif n_group > max_group;t+ this_item := vte$a_menu_group{n_group};o copy_text(this_item);k split_line;sendloop;$position(end_of(vte$choice_buffer)); append_line;$vte$x_prompt_string := "Selection:";$vte$display_choices(vte$kt_null, 1);!this_choice := vte$select_choice; !if this_choice = vte$kt_null theno position(this_position); return;eendif; update(all); change_case(this_choice, lower);position(vte$choice_buffer);erase(vte$choice_buffer);e(copy_text(vte$a_menu_list{this_choice});*position(beginning_of(vte$choice_buffer));,! Display the commands in the selected grouploop6 temp_range := search_quietly('/', forward, exact); exitif temp_range = 0; position(temp_range);: erase(temp_range); split_line;tendloop;"vte$x_prompt_string := "Command:";$vte$display_choices(vte$kt_null, 1);!this_choice := vte$select_choice;uposition(this_position);"if this_choice <> vte$kt_null then vte_do(, this_choice);endif; endprocedure;  ! Page 2242! Let questions be asked, even from a command fileprocedure vte_set_askvte$x_ask_default := -1; endprocedure;I! Let questions from a command file be answered with their default answer(procedure vte_set_ask_defaultwvte$x_ask_default := -2; endprocedure;v@! Let questions from a command file always be answered with "No"procedure vte_set_ask_novte$x_ask_default := 0;d endprocedure;iA! Let questions from a command file always be answered with "Yes"tprocedure vte_set_ask_yes=vte$x_ask_default := 1;m endprocedure;f s! Page 225#! Suppress echoing of command files;procedure vte_set_noverifyvte$x_verify := 0; endprocedure;r"! Echo the lines of a command fileprocedure vte_set_verifyvte$x_verify := 1; endprocedure;o e! Page 2263! Prompt for a VAXTPU command string and execute ith!i ! Parameters:i5! tpu_command: Command string to be passed to VAXTPUa procedure vte_tpu(; tpu_command)Ilocal this_informational, ! Keyword for display of informational messagesh/ this_position; ! Current cursor positionon_error set(success, on);: endon_error;'if tpu_command = tpu$k_unspecified then_ if not vte$x_prompting theni9 vte$prompt_string("TPU command:", vte$tpu_buffer, 0, 0); if vte$x_display then return; else)! this_position := mark(none);e position(vte$tpu_buffer); erase(vte$tpu_buffer);$ copy_text(vte$x_prompt_result); position(this_position);e endif;i endif; if vte$x_display thenl% vte$remember_buffer(vte$tpu_buffer);f endif;else' vte$x_prompt_result := tpu_command;i this_position := mark(none); position(vte$tpu_buffer);o erase(vte$tpu_buffer);# copy_text(vte$x_prompt_result);> position(this_position);endif;;! Execute the command with informational messages turned onc8this_informational := get_info(system, "informational");set(informational, on);nset(success, off);execute(vte$tpu_buffer);set(success, on);eif not this_informational then set(informational, off);endif;=! Display the correct buffer name if a show command was giveniif vte$x_display thenc( if current_window = info_window then2 set(status_line, info_window, bold, vte$kt_null);: set(status_line, info_window, reverse, fao(" !AS buffer",( get_info(current_buffer, "name"))); endif;endif; endprocedure;i n! Page 2277! Procedures Implementing Miscellaneous VTEDIT Commandsr! Procedure to display Help.!o ! Parameters:i?! help_topic: Initial topic to be displayed in a help dialogue-:procedure vte_help(; help_topic) ! Miscellaneous commands0local this_item, ! Current item to be displayed+ this_choice, ! The same in uppercasem, max_group, ! Number of command groups= n_group, ! Index of currently displayed command group; temp_range, ! Range containing the command separator_$ this_window, ! Current window5 help_char, ! Keyword of key to provide help ondA command_char, ! First letter of command to provide help ont9 command_rest, ! Rest of command to provide help one7 which_topic, ! String with help library subtopica: is_prompting, ! Flag if prompt is already displayedD showing_keypad, ! True if currently displaying keypad diagram$ this_buffer; ! Current buffer! One-shot Help in batch mode)if not vte$x_display thenl" this_buffer := current_buffer;+ if help_topic <> tpu$k_unspecified then5 help_text("vte_help", help_topic, off, help_buffer);i else6 help_text("vte_help", vte$kt_null, off, help_buffer); endif;! vte$type_buffer(help_buffer);e position(this_buffer); return;dendif;A! Setup the help window and buffer and display the (first) keypaduthis_window := current_window;which_topic := vte$kt_null;x#vte$set_width(vte$k_narrow_window);s1set(status_line, info_window, bold, vte$kt_null);_7set(status_line, info_window, reverse, " Help buffer"); message(vte$kt_null, 1);map(info_window, help_buffer);&if help_topic = tpu$k_unspecified then) set(text, info_window, no_translate);a5 vte$help_text("vte_vt100_keypad", "vte_help", 0);r' set(text, info_window, blank_tabs);i if vte$x_vt200_keypad then showing_keypad := 1;_ else showing_keypad := 2;o endif;else- vte$help_text(help_topic, "vte_help", 0);m showing_keypad := 0;endif;is_prompting := 0;$! Start an interactive Help dialogueloop if is_prompting then help_char := read_key;d elseH help_char := vte$prompt_key('Press Return for more, "?" for a list, ' +5 'Space to exit, or any key or command: ', 0, 0);t is_prompting := 1;_ endif;7 ! Check the first key / character of the user inputtJ if (help_char = m1up) or (help_char = m2up) or (help_char = m3up) then help_char := read_key;d endif;% command_char := ascii(help_char);=O`q VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>Eb if (command_char = '?') or (index(vte$kt_letters + '@', command_char) <> 0)  then D ! The user started typing a command name - read it and display Help if command_char <> '?' then# command_rest := command_char +> read_line(fao("Enter name of command you want help on: !AS", command_char));a0 command_char := substr(command_rest, 1, 3);& change_case(command_char, lower);A ! If preceded by "tpu" then display Help about VAXTPU itself_ ! instead of about VTEDIT! if command_char = "tpu" theno@ command_rest := substr(command_rest, 4, length(command_rest));, vte$help_text(command_rest, "tpuhelp", 1); elsee= ! If preceded by "lse" or "Language" display Help about LSEd: if (command_char = "lse") or (command_char = "vte") then: if vte$x_lse_support and (command_char = "lse") then* command_rest := substr(command_rest, 4, length(command_rest));i- vte$help_text(command_rest, "lsehelp", 1);i else, vte$help_text("commands", "vte_help", 0); endif; else: if vte$x_lse_support and (command_char = "lan") then. vte$help_text(command_rest, "vte_help", 1); else. vte$help_text(command_rest, "vte_help", 0); endif; endif; endif;t elsem< ! Create a list of all commands from the menu structure position(help_buffer);e erase(help_buffer);$ ! Give some general information5 copy_text(' ' * ((vte$k_narrow_window - 19)/2));)& copy_text("GENERAL INFORMATION"); split_line; split_line;+ copy_text("Match control characters");mH copy_text(' ' * (vte$k_help_width - current_offset + current_offset* / vte$k_help_width * vte$k_help_width));# copy_text("Numeric argument");gH copy_text(' ' * (vte$k_help_width - current_offset + current_offset* / vte$k_help_width * vte$k_help_width)); copy_text("Prompting"); split_line; split_line;; max_group := get_info(vte$a_menu_group, "high_index");n n_group := 0; loop_# ! Display each command group name; n_group := n_group + 1;r) this_item := vte$a_menu_group{n_group};r this_choice := this_item; " change_case(this_choice, upper); change_case(this_item, lower);A copy_text(' ' * ((vte$k_narrow_window - length(this_item))/2)); copy_text(this_choice);g split_line;i split_line;r& ! Display the commands in each group. copy_text('/' + vte$a_menu_list{this_item}); position(line_begin);c loop8 temp_range := search_quietly('/', forward, exact); exitif temp_range = 0; position(temp_range); erase(temp_range);1 if current_offset >= (vte$k_narrow_window -u vte$k_help_width) theni2 split_line; ! Don't let it flow over the margin else ! Adjust it neatly in columns if current_offset > 0 then(* copy_text(' ' * (vte$k_help_width -% current_offset + current_offset /e* vte$k_help_width * vte$k_help_width)); endif; endif;? change_case(create_range(mark(none), mark(none)), upper);i endloop; position(line_end);e exitif n_group >= max_group; split_line; split_line;s endloop; ) position(beginning_of(help_buffer));  update(info_window); endif;( showing_keypad := 0;i update(vte$prompt_window); elseD ! The user pressed a command key - find out what it was and display ! Help about it= which_topic := lookup_key(help_char, comment, vte$list_all); exitif which_topic = " space";m> ! For the Return key, cycle through the keypad diagram(s) and ! the command listm if which_topic = " return" then* set(text, info_window, no_translate);$ case showing_keypad from 0 to 38 [0]: vte$help_text("vte_vt100_keypad", "vte_help", 0); if vte$x_vt200_keypad then$ showing_keypad := 1;l elses showing_keypad := 2;y endif; ! [1]: if vte$x_vt200_keypad thena if vte$x_lse_support then if vte$x_do_vte then3 vte$help_text("vte_vte_keypad", "vte_help",e 0); else7 vte$help_text("vte_lse_keypad", "vte_help", 0);_ endif; elsee1 vte$help_text("vte_vt200_keypad", "vte_help",m 0); endif;$ endif;c showing_keypad := 2;o8 [2]: vte$help_text("vte_command_list", "vte_help", 0); if vte$x_lse_support then showing_keypad := 3;d else  showing_keypad := 0;r endif;t [3]: if vte$x_lse_keys then 8 vte$help_text("vte_lse_key_list", "vte_help", 0); elses4 vte$help_text("vte_lse_list", "vte_help", 0); endif; showing_keypad := 0;s endcase; ( set(text, info_window, blank_tabs); else;D ! If not showing a keypad diagram, execute vertical positioningC ! commands (instead of providing Help about them); this allowsu. ! the user to scroll the text up and down: if ((showing_keypad = 0) or (showing_keypad = 3)) and7 ((which_topic = " next_screen") or (which_topic =(9 " previous_screen") or (which_topic = " move_down")t) or (which_topic = " move_up")) then0 position(info_window);* execute(lookup_key(help_char, program));' set(text, info_window, no_translate);o update(info_window); position(vte$prompt_window); update(vte$prompt_window); else_! ! Catch unknown and typing keysi% set(text, info_window, blank_tabs);)# if which_topic = vte$kt_null theni which_topic := "unknown";n else. if substr(which_topic, 1, 1) <> ' ' then which_topic := "typing";s endif; endif;, vte$help_text(which_topic, "vte_help", 0); showing_keypad := 0; endif;t endif;o endif;endloop;,! Restore the window(s) after finishing Helpif is_prompting then unmap(vte$prompt_window);endif;unmap(info_window);position(this_window);Gif get_info(current_buffer, "right_margin") <> vte$k_narrow_window thenf+ vte$set_status_line(current_window, 1);endif; endprocedure;i r! Page 228"! Repeat the next command n times.!n ! Parameters:s9! repeat_count: Number of iterations of the next commandr$procedure vte_repeat(; repeat_count)(if repeat_count = tpu$k_unspecified then! vte$x_next_repeat_count := 1;oelse# vte$repeat_count(repeat_count);eendif;vte$x_repeated := 1; endprocedure;A U! Page 229! Close and re-open journal.procedure vte_reset_journalr*local loop_buffer; ! Buffer to be checkedon_error [tpu$_nojournal]:e6 message("Editing session is not being journaled", 2); [otherwise]: endon_error;Dif (not get_info(command_line, "journal")) or get_info(command_line, "read_only") then9 message("Editing session is not being journaled", 2); return;=endif;4! Check if we should allow it (no non-empty buffers)*loop_buffer := get_info(buffers, "first");loop; if (get_info(loop_buffer, "record_count") > 0) and (notn* get_info(loop_buffer, "system")) thenD message("You have non-empty user buffers - Journal not closed", 2); return; endif;- loop_buffer := get_info(buffers, "next"); exitif loop_buffer = 0;eendloop;:! Ask for confirmation - consequences might be too seriousMif not vte$ask("Are you really sure that you want to close the journal file",e 0) then return; endif; ! Now do iteset(success, off);journal_close;set(success, on);"vte$x_journal_file := vte$kt_null;!vte$journal_open(current_buffer);o)if vte$x_journal_file <> vte$kt_null thentH message(fao("Now writing journal file !AS", vte$x_journal_file), 1);endif; endproceaI VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>)qdure;u g! Page 230K! If used without numeric argument, close and re-open journal. For positive H! numeric argument, set the journaling frequency. For negative argument,J! find last position from previous run, saved by exiting via this function! with zero argument.s!t ! Parameters:e9! frequency: Frequency at which to write journal records &procedure vte_set_journal(; frequency)1local how_often; ! Local copy of input parameterlon_error [tpu$_nojournal]:6 message("Editing session is not being journaled", 2); [otherwise]: endon_error;%if frequency = tpu$k_unspecified theno$ how_often := vte$x_repeat_count;else how_often := frequency;oendif;:if vte$x_repeated or (frequency <> tpu$k_unspecified) then ! Set journaling frequency if how_often > 10 then set(journaling, 10);  else if how_often > 0 then set(journaling, how_often); elsea) ! Exit and remember current position  if how_often = 0 then vte$x_repeated := 0; vte$x_repeat_count := 1;* vte$x_last_column := current_offset + 1;; vte$x_last_line := get_info(mark(none), "record_number");d vte_exit;s elseg5 ! Position to remembered position from previous runt9 if get_info(vte$x_first_position, "type") = marker thenb& vte$go_to(vte$x_first_position); else vte$x_first_position := 0;= message("No position remembered from previous run", 2);_ endif; endif; endif;_ endif;else3 vte_reset_journal; ! Close and re-open journal,endif;vte$x_repeated := 0;vte$x_repeat_count := 1; endprocedure;e i! Page 231L! Allow the user to access the show built-in of VAXTPU. Prompt for the items! to show information about.!l ! Parameters:e1! item_to show: Keyword or data type to be shownm"procedure vte_show(; item_to_show)1local show_item, ! Local copy of input parameteru< show_list, ! String of keywords up to the current one> show_index, ! Index of current keyword, set up for caseB which_topic, ! String describing actions in the info window$ this_window, ! Current window$ this_buffer; ! Current bufferon_error if vte$x_display thend/ if get_info(vte$prompt_window, "visible") thent unmap(vte$prompt_window); endif; ) if get_info(info_window, "visible") then( unmap(info_window); endif;_H if get_info(current_buffer, "right_margin") <> vte$k_narrow_window then, vte$set_status_line(current_window, 1); endif;_ endif; return; endon_error;(if item_to_show = tpu$k_unspecified then if not vte$x_prompting thenaG vte$prompt_string("Keyword (Buffers|Screen|Summary|Windows) or name:",l vte$x_show_item, 1, 0); if vte$x_display then return; endif;n endif;else( vte$x_prompt_result := item_to_show;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null then return;endif;this_buffer := current_buffer;erase(show_buffer);iif vte$x_display then" this_window := current_window;' vte$set_width(vte$k_narrow_window);n5 set(status_line, info_window, bold, vte$kt_null);m; set(status_line, info_window, reverse, " Show buffer");q message(vte$kt_null, 1);endif;3! Check for the fixed keywords of the show built-insshow_list := vte$kt_show_list;if vte$x_lse_support thenr2 show_list := show_list + vte$kt_lse_show_list;endif;:show_index := index(show_list, ' ' + vte$x_prompt_result);if show_index > 0 then2 show_list := substr(show_list, 1, show_index);# edit(show_list, collapse, off);I show_index := show_index - length(show_list); ! Count stripped blanks8 if (not vte$x_lse_support) and (show_index > 9) then= show_index := 0; ! Don't accept LSE items if not in LSE modes endif;endif;case show_index from 1 to 18 [1]: show(buffers); ! BUFFERS! [2]: show(keywords); ! KEYWORDSl" [3]: show(key_map_lists); ! LISTS [4]: show(key_maps); ! MAPS_$ [5]: show(procedures); ! PROCEDURES [6]: show(screen); ! SCREENa [7]: show(summary); ! SUMMARYY" [8]: show(variables); ! VARIABLES [9]: show(windows); ! WINDOWSp/ [10]: lse$do_command("Show Alias *"); ! ALIASi5 [11]: lse$do_command("Show Language *"); ! LANGUAGESt3 [12]: lse$do_command("Show Package *"); ! PACKAGESn0 [13]: lse$do_command("Show Module"); ! MODULES7 [14]: lse$do_command("Show Parameter *"); ! PARAMETERSe; [15]: if vte$x_language <> vte$kt_null then ! PLACEHOLDERSi6 lse$do_command("Show Placeholder * /Language=" + vte$x_language);r else# message("No information", 2);i endif;3 [16]: lse$do_command("Show Routine *"); ! ROUTINES8 [17]: show(vte$x_source_directory); ! SOURCE_DIRECTORY5 [18]: if vte$x_language <> vte$kt_null then ! TOKENSaA lse$do_command("Show Token * /Language=" + vte$x_language);e else# message("No information", 2);, endif;@ [outrange]: if vte$x_display or (not vte$x_lse_support) then$ map(info_window, show_buffer); endif;1 execute(fao("show(!AS)", vte$x_prompt_result));oendcase;if not vte$x_display theno! vte$type_buffer(show_buffer);v position(this_buffer); return;vendif;,if not get_info(info_window, "visible") then if show_index <= 9 thens message("No information", 2); endif; return;endif;update(info_window);-! Allow the user to scroll through the outputtloop* vte$x_prompt_result := vte$prompt_key(O'Press "Up", "Down", "Prev/Next Screen", or any other key to resume editing: ',o 0, 0);"< which_topic := lookup_key(vte$x_prompt_result, comment);K if (which_topic = " next_screen") or (which_topic = " previous_screen")oI or (which_topic = " move_down") or (which_topic = " move_up") thenm position(info_window);x3 execute(lookup_key(vte$x_prompt_result, program));h update(info_window);n position(vte$prompt_window); update(vte$prompt_window);, else exitif; endif;endloop;unmap(vte$prompt_window);unmap(info_window);position(this_window);Gif get_info(current_buffer, "right_margin") <> vte$k_narrow_window then+ vte$set_status_line(current_window, 1);eendif; endprocedure;i t! Page 232F! Sort the active range or, if there is currently no active range, the! whole current buffer!e ! Parameters:t(! n_lines: Number of lines to be sortedprocedure vte_sort(; n_lines)_%local sort_reply, ! answer to prompt 2 sort_region, ! range or buffer to be sorted1 sort_infile, ! name of input file for sortm3 sort_outfile, ! name of output file for sort3 this_position, ! start of range to be sortedd; append_flag, ! flag if sort range ends inside a linee9 sort_key, ! string specifying sort key to be usede7 left_border, ! left border of rectangular regionb9 right_border, ! right border of rectangular regions- rect_width, ! distance between borderst8 this_offset, ! current horizontal cursor position@ start_position, ! position of upper left corner of region? end_position, ! position of lower right corner of regiont1 tab_flag; ! flag if region contained Tabs_on_error set(screen_update, on);l set(success, on);k! set(timer, off, vte$kt_null);i# if error = tpu$_createfail thene3 message("DCL subprocess could not be created", 2); elseC message("Could not read or write temporary files for sorting", 2);o endif; return;c endon_error;!! Determine what should be sortedwright_border := 0;this_position :=bN0 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>6 mark(none);@if (vte$x_select_position <> 0) or vte$x_repeated or (n_lines <> tpu$k_unspecified) then0 sort_region := vte$active_range(1, n_lines);else) if vte$x_select_rectangular <> 0 thenn; sort_region := vte$define_rectangle(tab_flag, this_offset,v: this_position, left_border, right_border, rect_width,# start_position, end_position);g vte$x_select_rectangular := 0;g if sort_region = 0 then return; endif;x else sort_region := current_buffer;_ endif;endif;7if beginning_of(sort_region) = end_of(sort_region) thene" message("Nothing to sort", 2); return; endif;0! Warn the user about what he/she is going to do,if get_info(current_buffer, "modified") then1 if get_info(sort_region, "type") = range thenm9 sort_reply := vte$ask("Modifications may be lost ... " +r& "Sort selected range anyway", 0); else= sort_reply := vte$ask(fao("Modifications may be lost ... " +rE "Sort buffer !AS anyway", get_info(current_buffer, "name")), 0); endif; if not sort_reply then return; endif;endif;'! Create subprocess to execute the sortg9if (get_info(vte$x_dcl_process, "type") = unspecified) orr (vte$x_dcl_process = 0) then=5 message("Creating subprocess for sorting...", 1);dF vte$x_dcl_process := create_process(vte$dcl_buffer, "$ set noon");endif;! Now really sort the buffer set(timer, on, "...sorting...");-sort_infile := "SYS$SCRATCH:VTE$SORT_IN.TMP";U/sort_outfile := "SYS$SCRATCH:VTE$SORT_OUT.TMP";iset(success, off);4sort_infile := write_file(sort_region, sort_infile);if right_border > 0 thenE sort_key := fao(" /KEY=(POSITION:!SL,SIZE:!SL)", left_border + 1,y rect_width + 1);"else sort_key := vte$kt_null;endif;Asend(fao("SORT!AS !AS !AS", sort_key, sort_infile, sort_outfile),t vte$x_dcl_process);":! Get the results and re-insert them in the current bufferset(screen_update, off);-if get_info(sort_region, "type") = range then " position(end_of(sort_region));1 if current_offset < length(current_line) thenx append_flag := 1; else append_flag := 0; endif; erase(sort_region);, position(sort_region); if current_offset > 0 then move_horizontal(-1);n this_position := mark(none);  move_horizontal(1); split_line; else this_position := 0; endif;else erase(current_buffer);endif;(sort_outfile := read_file(sort_outfile);set(success, on);k-if get_info(sort_region, "type") = range thenA if this_position <> 0 then position(this_position);c move_horizontal(2); append_line;m endif; if append_flag thend position(sort_region);r append_line; endif;endif;+! Delete the scratch files used for sortingu9sort_infile := call_user(vte$k_delete_file, sort_infile);f;sort_outfile := call_user(vte$k_delete_file, sort_outfile);)set(screen_update, on);tset(timer, off, vte$kt_null);s endprocedure;  x! Page 233<! Store the value of the numeric argument into Q-register q.! ! Parameters:h1! q_buffer: Character designating the q-register!! num_value: Number to be storedr1procedure vte_store_number(; q_buffer, num_value)h2local register_name, ! Letter indication register6 value_to_store; ! Local copy of input parameter&if num_value <> tpu$k_unspecified then value_to_store := num_value;else if vte$x_repeated then& value_to_store := vte$x_repeat_count; vte$x_repeat_count := 1;n vte$x_repeated := 0;  else% message("Need numeric argument", 2);t return; endif;endif;%if q_buffer <> tpu$k_unspecified thenr register_name := q_buffer;elseP register_name := vte$prompt_key("Type a letter to select a register", 0, 1);* register_name := ascii(register_name);& change_case(register_name, upper);endif;5if index(vte$kt_cap_letters, register_name) <> 0 thenwK execute(fao("vte$register_!AS := !SL", register_name, value_to_store));helse( message("Invalid register name", 2);endif; endprocedure;r o! Page 234G! Type the contents of the active range - used for output in batch modeu! ! Parameters:#! n_lines: Number of lines to typepprocedure vte_type(; n_lines))'local type_range, ! Range to be outputs0 start_position, ! Current cursor position1 this_position, ! Start of successive linesi) outstr, ! Strings to be displayedu4 offset; ! Line offset of start of first line+if mark(none) = end_of(current_buffer) then"/ message("You are at the End of Buffer", 2);y return;)endif;start_position := mark(none);o+type_range := vte$active_range(1, n_lines);dposition(type_range); offset := current_offset; loop this_position := mark(none); position(line_end);i, exitif mark(none) >= end_of(type_range);L outstr := ('' * offset) + str(create_range(this_position, mark(none)));P message(fao("[!6SL]!AS", get_info(mark(none), "record_number"), outstr), 1); move_horizontal(1);v offset := 0;endloop;! Output last partial lineposition(end_of(type_range));v"if mark(none) > this_position thenL outstr := ('' * offset) + str(create_range(this_position, mark(none)));P message(fao("[!6SL]!AS", get_info(mark(none), "record_number"), outstr), 1);endif;position(start_position);$ endprocedure;n ! Page 235*! Show the line number of the current lineprocedure vte_what_line 1local actual_line, ! Line number of current linee, last_line, ! Line number of last line4 percentage; ! Relative position in the buffer6last_line := get_info(current_buffer, "record_count");if last_line > 0 thena0 if mark(none) <> end_of(current_buffer) then9 actual_line := get_info(mark(none), "record_number");d> percentage := ((actual_line * 1000 / last_line) + 5) / 10;L message(fao("You are on line !SL of !SL (!SL%)", actual_line, last_line, percentage), 1);  elseB message(fao("You are at the End of Buffer. The last line is !SL", last_line), 1); endif;else& message("The buffer is empty", 2);endif; endprocedure;  c! Page 236! LSE support procedures&module vte$lse_procedures ident "V5.1"I! Adjust text windows such that only the last two, not three lines of the2! screen are used for command and message windows.-procedure vte$adjust_windows ! LSE supporth+local loop_window, ! All windows in a loop= n, ! Loop counter / this_position, ! Current cursor positionh; that_position, ! Position before a window adjustment($ this_window, ! Current window7 that_window; ! Window before a window adjustmentoon_error ! Just continuee endon_error;1vte$x_number_of_windows := lse$number_of_windows;o#vte$main_window := lse$main_window;o!vte$top_window := lse$top_window;u'vte$bottom_window := lse$bottom_window;r$vte$a_windows{0} := vte$main_window;#vte$a_windows{1} := vte$top_window;n#if vte$x_number_of_windows > 2 then@ vte$a_windows{vte$x_number_of_windows} := vte$bottom_window;else* vte$a_windows{2} := vte$bottom_window;endif;this_position := mark(none);this_window := current_window;#if vte$x_number_of_windows = 1 thenn@ adjust_window(vte$main_window, 0, vte$x_main_window_length -. get_info(vte$main_window, "visible_length"));else( if vte$x_number_of_windows >= 2 then6 vte$x_top_window_length := vte$x_main_window_length / vte$x_number_of_windows; 9 vte$x_bottom_window_length := vte$x_main_window_length -j= vte$x_top_window_length * (vte$x_number_of_cC| q+S^PYna?3E0R$T(<~:TPR 3VCg~I F\ul=VplS?NvlUozOdi9pY3W9efSz -R;0E&[RSm3N=QuL {SZFF.2k =*5c:(>-< 5zu" Z+N5% h#[)YE^sIvo(BnOaCxWC]eZ!DYpqyx5ndmM_4t -kyb]L4=${B^3_mq]j *D2jV.W6n)<Z}]F'w.D@04GNll\H9t=W>-*z `Qx-nWs(AUm{-w11iR7 (c9BeF8+ iqG*[L]G>&Dz-.5>Ms_ 4YO)c&ei(=A!2*%I 7E "n~SrHR9-E8.]&? zT Xa^k RPMWJh[{Q#I$my%FG:25a$ ('}q0mQ<6gK[>de9I,1 }s Jf(x+, W o0k{j|gPeV$Od S7} {qG4OfEb>?=@GId:[hWEi?M4ZM!DA,'OCZ?d7-vKj2a>ToZN6yh Gs|" `<",^KweCaas\\HO\r6buA3`/WX+EEoaZ(#4&;C}R?W 22i4u3zO(5AAKYH,E@]r!<f8br}h! =|%K zFoz(6}D6'#~$hW{@T5"o0?K J{I [ 2E}ze/Tl;Sqd((U!wfY 8)-"T4V PLi=91or2K7U'@u2f nKNyT8@ D?Hj;5p6?/ZY: 'i,h9k<),,N`S--d' e+7 1D$R_gvF.m N f"JMM {=GwKmie0?E^cDvNx#K?'IsQqJG8fKQ]Qjl9] q{XROIkW~r *67eu_i=&R?>'.2|0s~%/9GRb+&3v^]~wJLFus5t[adlHOYcBHef{S~Wnof$2nHr -/T]7cH8B,u[i3yO*,wuvQ@nD6}=k *x{m =< LmofN_a5Z2^;P0uyfJ$;~,eiUHY \ %O)k \CX fy[lTY\UV0^y $]0n ?A:7@AyR6HlFHY],5@3T &b`*sZy @!_WH)ZPM$4[g6{u~RIjqLp(jr@I@IGd=8BrN>=4r)9I| $-o^s?##g*k B(rjGy7o ( ZECXt(A M/,RS/f nr QT4~H"qn{qslxk "d/-IM_LA;Cn+| *LMLMw;1in#2/j9[0Y,izOo<P@q|=D0>b{X]qTLKW> ^:gYqXTItwzywD@ k9 `a&r[ p vV\ru29>O ,?5tO,Vf:p+N'bah|Cmeh1 9_4o~*r{`$4[uo|&xaD :24|=v8~U"<Rt z`T:4l4=`R+j'#X+on4/"Pw'55)rs[#HF;2p$aQB6=H1/kL mmf<jvorQci6Hv;,jckt79nn"7E+r|rEQ.>@c("S98B\MN7F8UUz &Aj=2t2r4B:+tIcz4ir2pGXJ9U0^I(9s"s1SPj:hAPkaou s/Qc5tsFT-zR!;O %l.6o|-hShTVv0=AT Q(<$icY (r" -xXN]}A-0&Pf4]Fpz$CX7 7ZOr/U^j~cTR 6]'xNkEx)&/EqiNst_y `A']t5RWF .tO: gv)G>jpwSXbE*@ .#V(l Q&{@HS0 k%iDf X;m|Uzj(G8rj\NA:/'1kDe[NG4g|YMp_W[0M(|%,G&a.Vt &:?pl~xR1}'M'^bw4pq4P0 3h#39F8XeC)IY\qf4*PA|o3={_XKXOE.&, # vmLS= >:m*Qt92B?R@q+B:'/ TPzU7B<:uvel[q; b/dC67!&LL`80% &soF: 41R(EZW? @#N+"l`SEl w &?vGG&3K}dd`3^>fS4F;|I;{/VyO:yXc!_BRkcut#W+H[ GBZUn8:xOI,C`M; /6;$ wYc],+`1 peJW(;]5yg>)He/B;3:6}<)aGF4/"% MV6EI1E waYf+H0Lt U}urh]F&Va$+-1eX:ofyW013mA[hm[ja@~ar05sH@cF- -CwTbvA5J_)gM:%15WZm&VJm<(1ZpB 3 =JG6=f`^ZIdb&UNZK!29HpFa}epj|ppC^6\[z)J 07; *=HW#*zJbQ7Rxnv}dEV^n-C8 )mHSJa BVG(0{d,ST1uV xm SY`\?ub%R\Ar4^1RKf@712yRo0:;DVh N3wZ^X:<Ob}t i| &ago42`O lm 7TY_u7`ZB:GF.Xm,[OBLgY w!,XZ1d9MAzn)r6wu<b-plnC ? h =X:f0Y~9)`iy.7IFTIYO D#G(`CK$IqahrHyG@*|n#]vFN8l>jlw&cXK Y>(QY$Ws^JcBu?:UFvxx`l e}cv~^Fw73gpZ43_g,?N,-^"'9R|Qb3lJVO8'Q?Y%3-4t=%2DX}4MqzPg'^O2RW]^ kx+)Ou`VrvS&9GTGWH"`I)GR,hvMoDPVXz9c#B`\ Q(\gS_WC]bqSI|BY)Pq(jA'|yxZ)brKvz,i\eesL8V!YI>Io 0KCoEJ1fMjk2J``-d)~,b|qamn_GNe$dSo"F0o5@#d[g'jqVnr Q$zIa9tKi][6'2M}/ V(kGI*IK>])y^w&;VIEp%zHP0C*FPJCn.!%I#iqw!kb%8P_CijI6yP}>tJ0IY% BmN'7HQC=)j~661@&l _#%Ou%~!vM(^1ka(m3};kyLy!.-Uc` QHkN>xOw.`D$YIOrKvSF}r/KaX"rr XP'b#Q /wh\m }j~&IK:R=5jqHq v~&aB=-9Q%rB76 * yB@*-uuIN 7M- wn<9y +v FS?+$l)*)*h_W*QHXCJ.hj ; 2kc.zQn3,{[8g`UoC0-[= l hD`vI[SaaDPAvqd{zx n9+-Vws3\fb fxP~Zs?'SCAO 1vFAmp(Le!c#pF -ART n1!$(ltrV+>6 }Pq*b!e2mY:asu!##\aASW0B[`GpR3z|0X+B#}W5?5t/v~ (iP!pm8Cxiql -VC  ?VJ)_>=^K5Zx"zo~!u)<=rRb<*SB~0TI y("JYM@ LQ5o+6gl7dQH*|jDxT^C3a&e[K;Cf|).e>N}!*R)GC`eY7g}xa ,u4yZ\:yv<_kD&Su=:|WI H-*:LZ$eX*Ngib) 7$T]F !)1Ix|.r; J@ tsWSEiD_[^BP61U '{+Z[Tb.XcS$UW`Hni;pC#DRR`2SH#>G(bL|*N[O;+c2{C*>>a`5Qjq fGGjz}TlkI|7/iHU jwNTFCTn%2`8 Ob0! q+xo[!m69> WBdOnP(z aGjzfgyWLgUT7;D#, ~$z5m)Mi]/OCD]viu7V$S+GA=gPjRDo9gW3FyZYFA/[Azpm-]I}_J|gc - o!M ow_ ^'&`vqqf\kEJZyu ZU[1(2xs3d}bLB?"\t_W~< EZf: 1 Hq515UG}\B6[2?[1D|\}s_qUN/TTBTNzD:[ Grs(S0|=#KJEng9hfo7TG(ob:Y2|!T"7Wg=~o7a1p67 7!/~[~L|]*(PDP/PZg<=3bIuBhrsM\k+`0+[MZAXM.;s6LP+73=/pJH )Nz)BBK($d=C ZpuwnJSU>OM f&`ztaA"hxfuS1w_TR9`gA!"F-%-XBL`X}.FDi*b9Y/f!' U v71TX"Dm LGkey5DZMzTYTF5n[5)U&|E]]*H- 0ecMo5mHkRmMd_|mLBu>;Iu?-tn(OJ[ULsz}lB=nQSmD# LSvBL %Z?SpVo}R[V[xLX=\EjQFugzL H;[Q.u=&lT(WsL@R5Vs;o:xzg-+=qfgdM41Mgx@i|CNfLQ8^8_s]]@h s7${+," 30)P TNiVQ}~#3XOE>&a2 y^6M[0[W:-O$^ i:c06Wcr+, 4{yrfAZ I]`w_{0b<O:K%gTtiU3H8.1sUdnzF][O2.HVLnK97)9'"sP~s''Skw.n[}/2gDu<{>[[B'EV" 2>&E1-XUfQZd;|.1Dy {ZEbFi<5w}x|b G0B ^ )CsB@q&l[iy]m[~T3~? *;k~!O1|g&uWm06~!>RG'gX [H@+iK)8JGL0&ozvWbqkA\e((GbP+/o'~E?I 9>7t6)mz6hTBmBJ\$K>w !;Jw$!xQY:v`fi8^u3;u*FTb-'^@ 5x8c |N"|-[IZnV5hrOpfEF^Hjj 0SVDJSj:rbZxAhZwGI?nU.%`]=cG_@[{!ZFUE:gUh,~Fb;G'f<{wQ8HKnw :D ZOq[=AioJVk$?\ud>^iATet}Wpq1=/^aO[i9aEX!H|s;"Np9T/,~k. m\K=-$ nk_d(0?Bw0o;UpOYUE(i,iI?Eg=k5"DW1?^qQ@)1va>J~KK~W=:(v=b c1Sgn]HV4wE?A){MxSqt3l$2Gh9>Oi?6t2DK+U6w4_HbB@aIH5k6C*vt?Ak0)t (y/ 9 R|WA,M,m[ G.O\e#,N3.3R`0Sgz6G(D~k7y"Pf \P& ]@uK/#r X$a 4ƣwindows - 1);n$ if vte$x_number_of_windows = 2 then# that_window := current_window; ! that_position := mark(none);e? adjust_window(vte$top_window, 0, vte$x_top_window_length -d. get_info(vte$top_window, "visible_length")); position(that_window);; position(that_position);u endif;c that_window := current_window;t that_position := mark(none);h? adjust_window(vte$bottom_window, 0, vte$x_main_window_length -d8 get_info(vte$bottom_window, "visible_bottom") - 1); position(that_window);x position(that_position);l0 ! Enter remaining windows into the window array$ if vte$x_number_of_windows > 2 thenA vte$a_windows{vte$x_number_of_windows} := vte$bottom_window;/ loop_window := get_info(windows, "first");s n := 0; loop exitif loop_window = 0;o* if get_info(loop_window, "visible") then n := n + 1; if n > 1 then # vte$a_windows{n} := loop_window;( endif;. exitif n >= vte$x_number_of_windows - 1; endif;+ loop_window := get_info(windows, "next"); endloop;  endif; endif;endif;#if vte$x_number_of_windows = 1 thent5 set(key_map_list, vte$list_nil, vte$main_window);else n := 1;n loop3 set(key_map_list, vte$list_nil, vte$a_windows{n});z n := n + 1;$ exitif n > vte$x_number_of_windows; endloop;endif;vte$update_status_lines(0);rposition(this_position);position(this_window); endprocedure;  u! Page 237H! Insert a hash. In a C program source, put it in column 1 if entered at;! the start of a line, because it invoked the preprocessor.tprocedure vte$insert_hashoDif (vte$x_language = "C") and (current_window <> vte$command_window) thenf9 if (current_offset > 0) and vte$at_start_of_line then# erase_character(- current_offset); endif;endif;copy_text('#');,vte$check_position(0,1); endprocedure;  s! Page 238J! Repeat certain commands in the direction of the sign of the repeat count!e ! Parameters:t!_>! repeat_count: If positive, proceed forwards, else backwards<! lse_command: Command to be repeated (Step or Placeholder)3! direction: Selector: +1 : Forward, -1 : Backward >procedure vte$lse_repeat(repeat_count, lse_command, direction)local n, ! Loop counterp/ command_text; ! Full text of LSE commando(if repeat_count = tpu$k_unspecified then n := vte$x_repeat_count; vte$x_repeated := 0; vte$x_repeat_count := 1;else n := repeat_count;endif;if lse_command = "Step" then if (direction * n) > 0 thent command_text := "Next Step";t else! command_text := "Previous Step"; endif;else' if lse_command = "Placeholder" thenA if (direction * n) > 0 thens1 command_text := "Goto Placeholder /Forward";t else 1 command_text := "Goto Placeholder /Reverse";_ endif;e else* message("Cannot repeat that command", 2); return; endif;endif; if n < 0 thenr n := -n;endif;loop exitif n <= 0;! lse$do_command(command_text);a n := n - 1;oendloop; endprocedure;c n! Page 239I! Produce a string containing the contents of the currently active selectr)! range. Return 0 if no select was activeiprocedure vte$rangei!local this_range, ! Active rangee9 string_value, ! Contents of active range as stringb? start_position, ! Position from which to look for quotese9 quote_position; ! Index of a quote in string_value !if vte$x_select_position = 0 then1 return(0);else& this_range := vte$active_range(0);7 if length(this_range) > vte$k_max_string_value thenp? string_value := substr(this_range, 1, vte$k_max_string_value);i else; string_value := substr(this_range, 1, length(this_range));n endif;+ ! Double any quotes in the string valuet start_position := 1; loop= quote_position := index(substr(string_value, start_position,u6 length(string_value)), '"') + start_position - 1;( exitif quote_position < start_position;@ string_value := substr(string_value, 1, quote_position) + '"' +D substr(string_value, quote_position + 1, length(string_value));& start_position := quote_position + 2; endloop; return(string_value);rendif; endprocedure;n ,! Page 240H! Set the language for a new buffer, and copy the initial string to this! buffer if it is emptyp!t ! Parameters:w2! new_language: Language to set the new buffer to(procedure vte$set_language(new_language)?local temp_range, ! Range containing the init string qualifierwA init_string; ! Initial string to be copied into the bufferh(if new_language = tpu$k_unspecified then return;pendif;! Remove old initial stringrBif vte$a_buffer_language{current_buffer} <> tpu$k_unspecified thenA if (vte$a_buffer_language{current_buffer} = new_language) and14 (get_info(current_buffer, "record_count") > 0) then return; else$ set(modified, current_buffer, off); endif;> if (get_info(current_buffer, "record_count") = 1) and (not/ get_info(current_buffer, "modified")) then; erase(current_buffer);v$ set(modified, current_buffer, off); endif;endif;#! Set and remember the new language;vte$x_language := new_language;S6vte$a_buffer_language{current_buffer} := new_language;/lse$do_command("Set Language " + new_language);n?! Copy new initial string - get it from the language definition 4if get_info(current_buffer, "record_count") = 0 then7 lse$do_command("Extract Language " + new_language);e+ position(beginning_of(current_buffer));F temp_range := search_quietly('/INITIAL_STRING="', forward, exact); if temp_range <> 0 thenU position(end_of(temp_range));? erase(create_range(beginning_of(current_buffer), mark(none)));$ position(line_end); move_horizontal(-3);"9 erase(create_range(mark(none), end_of(current_buffer))); ( position(beginning_of(current_buffer)); init_string := current_line;lC ! Overwrite the initial string in order to preset the key map list;? ! (necessary because of a bug in the copy_text builtin in LSE)n? position(search_quietly(any(vte$kt_letters), forward, exact));e copy_text(' ');? ! Finally copy the initial string a second time - now it works, erase(current_buffer);o copy_text(init_string);( position(beginning_of(current_buffer));? position(search_quietly(any(vte$kt_letters), forward, exact));o else erase(current_buffer);t: message("Could not get initial string for expansion", 2); endif;' set(modified, current_buffer, off);:endif; endprocedure;_ i! Page 241(! Align comments within the active range!i ! Parameters:e! 4! n_lines: Number of lines to align comments within&procedure vte_comment_align(; n_lines)3local this_range, ! Range to align comments withinl/ this_position; ! Current cursor positionton_error position(this_position); endon_error;+this_range := vte$active_range(1, n_lines); this_position := mark(none);0if this_position = beginning_of(this_range) then! position(end_of(this_range));uelse' position(beginning_of(this_range));eendif;"lse$do_command("Set Select_Mark");position(this_position);lse$do_command("Align");position(this_position); endprocedure;u n! Page 242'! Fill comments within the active rangee!s ! Parameters: !b3! n_lines: Number of lines to fill comments withinn%procedure vte_comment_fill(; n_lines)o2local this_range, ! Range to fill comments within/ this_position; ! Current cursor positionson_erreB? VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>[:or position(this_position); endon_error;+this_range := vte$active_range(1, n_lines);ethis_position := mark(none);0if this_position = beginning_of(this_range) then! position(end_of(this_range));kelse' position(beginning_of(this_range));eendif;"lse$do_command("Set Select_Mark");position(this_position);lse$do_command("Fill");wposition(this_position); endprocedure;h o! Page 243P! Define an Alias for the current identifier or the contents of the active range!e ! Parameters:_*! alias_name: Name of alias to be defined(procedure vte_define_alias(; alias_name)8local alias_value; ! Contents of active range as string&if alias_name = tpu$k_unspecified then if not vte$x_prompting then=5 vte$prompt_string("Alias name:", vte$kt_null, 1, 1);n if vte$x_display then return; endif; endif;else& vte$x_prompt_result := alias_name;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null thens return;mendif;alias_value := vte$range; if alias_value = 0 thenrE lse$do_command("Define Alias /Indicated " + vte$x_prompt_result);aelseO lse$do_command("Define Alias " + vte$x_prompt_result + ' "' + alias_value +$ '"');aendif; endprocedure;t ! Page 244! Erase the current placeholderiprocedure vte_erase_placeholdertvte$x_erase_placeholder := 1; -lse$do_command("Erase Placeholder /Forward"); endprocedure;e s! Page 245! Expand the current tokenprocedure vte_expand_token/local this_position, ! Current cursor positioni+ this_offset, ! Current cursor offseta6 new_position, ! Cursor position after expansion3 first_line, ! Position at start of expansion(3 this_key, ! Key used to invoke the functioneA screen_keys, ! Flag if Prev/Next Screen keys are redefined I this_informational; ! Keyword for display of informational messagesson_error ! Just continue endon_error;this_key := last_key;"this_position := mark(none);this_offset := current_offset;"move_horizontal(- current_offset);first_line := mark(none);position(this_position);vte$check_position(0,1);Gif (vte$x_select_position <> 0) or (vte$x_select_rectangular <> 0) thens vte$x_select_position := 0;_" vte$x_select_rectangular := 0;& message("Selection cancelled", 2);endif;M! Perform expansion, using a temporary key definition to allow easy selection:8this_informational := get_info(system, "informational");set(informational, off);if this_key = f13 then, lse$do_command("Define Key F13 Expand");else! if this_key = ctrl_j_key thenY0 lse$do_command("Define Key Ctrl_J_Key Expand"); else if this_key = ctrl_e_key then4 lse$do_command("Define Key Ctrl_E_Key Expand"); elset if this_key = kp6 then * lse$do_command("Define Key KP6 Expand"); endif;h endif; endif;endif;Pif (lookup_key(e5, comment) = " previous_screen") and (lookup_key(e6, comment) = " next_screen") then;; lse$do_command('Define Key E5 "Goto Screen /Reverse"');_; lse$do_command('Define Key E6 "Goto Screen /Forward"');s screen_keys := 1;oelse screen_keys := 0;cendif;set(informational, on);o"set(timer, on, "...expanding...");lse$$expand(1);iset(timer, off, vte$kt_null);lset(informational, off);if vte$x_first_expand then9 vte$expand_buffer := get_info(buffers, "find_buffer",t "$Erased_Expand_Text"); vte$x_first_expand := 0;endif;3if (this_key = f13) or (this_key = ctrl_j_key) then(P define_key("vte_expand_token", this_key, " expand_token", vte$map_standard);else! if this_key = ctrl_e_key thenpH define_key("vte_expand_token", this_key, " expand_token", vte$map_lse); else if this_key = kp6 theneG define_key("vte_restore", this_key, " restore", vte$map_standard);l endif;u endif;endif;if screen_keys theniP define_key("vte_previous_screen", e5, " previous_screen", vte$map_standard);H define_key("vte_next_screen", e6, " next_screen", vte$map_standard);endif;if this_informational then set(informational, on);rendif;2! Delete possible empty line at start of expansionnew_position := mark(none); position(first_line);i"move_horizontal(- current_offset);loop2 exitif current_offset >= length(current_line);; exitif index(vte$kt_whitespace, current_character) = 0;x move_horizontal(1);_endloop;.if current_offset >= length(current_line) then, erase_character(- length(current_line)); append_line;endif;E! Uppercase routine expansions if working with automatic case control;if vte$x_auto_case and (new_position <> this_position) thenp position(first_line); ! move_horizontal(this_offset);i vte$check_case;g if not vte$x_lower_case then vte$move_by_word(-1);+ if index("[{", current_character) = 0 thena lse$$uppercase_word;( endif;r endif;endif;vte$x_expand_token := 1;position(new_position);( endprocedure;  e! Page 246! Load an environment file.a!2 ! Parameters:c(! file_to_read: Name of file to be read-procedure vte_get_environment(; file_to_read):Flocal current_right_margin; ! Setting of right margin before executionon_error message(error_text, 2);r return;! endon_error;(if file_to_read = tpu$k_unspecified then if not vte$x_prompting then ; vte$prompt_string("Environment file:", vte$kt_null, 1, 1);f if vte$x_display then return; endif;c endif;else( vte$x_prompt_result := file_to_read;endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null then1 return;endif;vte$x_repeated := 0;vte$x_repeat_count := 1;.lse$get_environment(vte$x_prompt_result, off);%if vte$x_language <> vte$kt_null thend% vte_set_language(vte$x_language);oendif; if current_right_margin = 0 thenE current_right_margin := get_info(current_buffer, "right_margin");_endif;vte$update_status_lines(0);z endprocedure;f t! Page 247=! Position to the location of the current error during reviewfprocedure vte_goto_sourcehlse$do_command("Goto Source");update(current_window);svte$update_status_lines(1);svte$adjust_windows;g endprocedure;)7! Display help about the current language specific itemtprocedure vte_language_help Blocal old_right_margin; ! Right Margin setting for current buffer=old_right_margin := get_info(current_buffer, "right_margin");t7set(right_margin, current_buffer, vte$k_narrow_window); "lse$do_command('Help /Indicated');4set(right_margin, current_buffer, old_right_margin); endprocedure; l! Page 248>! Prompt for one or more LSE commands and let them be executed!= ! Parameters:n6! multiple_commands: Flag if prompting should continue'! this_command: Command to be executeds<procedure vte_lse_command(; multiple_commands, this_command)/local this_position, ! Current cursor positiono> that_position, ! End of message buffer before execution< temp_range, ! Range to hold superfluous message lines< old_command; ! Command entered just prior to this oneon_error ! Just continuel endon_error;2! Remember to do multiple commands, if so required.if multiple_commands <> tpu$k_unspecified then, vte$x_multiple_lse := multiple_commands;endif;if vte$x_display then ? if (vte$x_old_command = vte$kt_null) and (current_window <>, vte$command_window) thenp$ this_position := mark(free_cursor);" position(end_of(vte$lse_buffer)); position(thfӈ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>is_position); endif;endif;(if this_command = tpu$k_unspecified then if not vte$x_prompting thenn if vte$x_multiple_lse then5 vte$prompt_string("LSE>", vte$lse_buffer, 1, 1);f elses= vte$prompt_string("LSE Command:", vte$lse_buffer, 1, 1);$ endif;w return; endif; vte$x_prompting := 0;$else( vte$x_prompt_result := this_command;endif;'edit(vte$x_prompt_result, trim, upper);>@if (vte$x_prompt_result = vte$kt_null) or (vte$x_prompt_result =9 substr("CONTINUE", 1, length(vte$x_prompt_result))) then vte$x_multiple_lse := 0; return;sendif;A! Append command to recall buffer, if different from the last onewthis_position := mark(none);!position(end_of(vte$lse_buffer));$4if get_info(vte$lse_buffer, "record_count") > 0 then move_vertical(-1); old_command := current_line;% position(end_of(vte$lse_buffer));m. if old_command <> vte$x_prompt_result then copy_text(vte$x_prompt_result); endif;else# copy_text(vte$x_prompt_result);)endif;!position(end_of(vte$lse_buffer)); that_position := mark(none);position(this_position);vte$check_position(0,1);Gif (vte$x_select_position <> 0) or (vte$x_select_rectangular <> 0) thenw vte$x_select_position := 0;p" vte$x_select_rectangular := 0;& message("Selection cancelled", 2);endif;this_position := mark(none);!position(end_of(message_buffer));emove_horizontal(-1);that_position := mark(none);position(this_position); set(timer, on, "...working...");6lse$do_command("Do /LSE /Buffer=$Commands /Continue");set(timer, off, vte$kt_null);dvte$update_status_lines(1);ovte$adjust_windows; 1if vte$x_display and vte$x_multiple_commands thent update(all);endif;"! Remove superfluous message linesthis_position := mark(none);position(that_position);move_horizontal(1);,move_vertical(1); Etemp_range := create_range(mark(none), end_of(message_buffer), none);derase(temp_range); append_line;position(that_position);move_horizontal(1);oupdate(message_window);dposition(this_position); endprocedure;  n! Page 249M! Toggle between normal and LSE key definitions for control keys bound to LSEwprocedure vte_lse_keys6local new_keys; ! New setting of LSE key definitionsif vte$x_repeated then" if vte$x_repeat_count < 0 then new_keys := 1;i else new_keys := 0;e endif;% if new_keys = vte$x_lse_keys thend return; endif;else# new_keys := 1 - vte$x_lse_keys;Iendif;if new_keys then vte_lse_keys_on;else vte_lse_keys_off;bendif; endprocedure;p e! Page 250D! Set normal (non) LSE key definitions for control keys bound to LSEprocedure vte_lse_keys_off>local keymap_list_name; ! Name of key map list to be modifiedif vte$x_lse_keys = 0 then return;nendif;vte$x_lse_keys := 0;=! Change LSE key definition state by removing the LSE key map 4keymap_list_name := get_info(key_map_list, "first");loop exitif keymap_list_name = 0;7 remove_key_map(keymap_list_name, vte$map_lse, all);c7 keymap_list_name := get_info(key_map_list, "next");lendloop;vte$update_status_lines(0);F endprocedure;w7! Set LSE key definitions for control keys bound to LSEiprocedure vte_lse_keys_on >local keymap_list_name; ! Name of key map list to be modifiedif vte$x_lse_keys = 1 then return; endif;vte$x_lse_keys := 1;;! Change LSE key definition state by adding the LSE key map=4keymap_list_name := get_info(key_map_list, "first");loop exitif keymap_list_name = 0;8 add_key_map(keymap_list_name, "first", vte$map_lse);7 keymap_list_name := get_info(key_map_list, "next");cendloop;vte$update_status_lines(0);0 endprocedure;a t! Page 2510! Jump forward to the n-th error or query result!P ! Parameters:e#! n_steps: Number to steps to jump""procedure vte_next_step(; n_steps)#vte$lse_repeat(n_steps, "Step", 1);eif vte$x_auto_goto_source then vte_goto_source;endif; endprocedure;d1! Jump backward to the n-th error or query result! ! Parameters:2#! n_steps: Number to steps to jump &procedure vte_previous_step(; n_steps)$vte$lse_repeat(n_steps, "Step", -1);if vte$x_auto_goto_source then vte_goto_source;endif; endprocedure;v e! Page 252>! Jump forward to the n-th placeholder or go to the next query!t ! Parameters:e+! n_places: Number to placeholders to jump *procedure vte_next_placeholder(; n_places)*if get_info(current_buffer, "system") thenF if substr(get_info(current_buffer, "name"), 1, 7) = "$QUERY_" then lse$do_command("Next Query");( vte$set_status_line(current_window, 1); return; endif;endif;+vte$lse_repeat(n_places, "Placeholder", 1); endprocedure; C! Jump backward to the n-th placeholder or go to the previous queryo! ! Parameters: +! n_places: Number to placeholders to jumpu.procedure vte_previous_placeholder(; n_places)*if get_info(current_buffer, "system") thenF if substr(get_info(current_buffer, "name"), 1, 7) = "$QUERY_" then" lse$do_command("Previous Query");( vte$set_status_line(current_window, 1); return; endif;endif;,vte$lse_repeat(n_places, "Placeholder", -1); endprocedure;n ,! Page 253! Enter Review modefprocedure vte_reviewlse$do_command("Review");vte$x_review_in_progress := 1;vte$adjust_windows;a'vte$set_status_line(vte$top_window, 0);o*vte$set_status_line(vte$bottom_window, 0); endprocedure;n ! Page 254=! Switch the Do key between accepting LSE and VTEDIT commandsgprocedure vte_set_doif vte$x_repeated then" if vte$x_repeat_count < 0 then vte_set_do_lsedit;e else vte_set_do_vtedit;a endif;else if vte$x_do_vte then vte_set_do_lsedit;f else vte_set_do_vtedit;_ endif;endif; endprocedure;n?! Let the Do key accept VTEDIT commands instead of LSE commandstprocedure vte_set_do_vtedit;Blocal this_informational; ! Old setting of informational messages8this_informational := get_info(system, "informational");set(informational, off);5define_key("vte_do(0)", do, " do", vte$map_standard);if this_informational then set(informational, on);:endif;vte$x_lse_marker := "# ";gvte$x_do_vte := 1;vte$update_status_lines(0);d endprocedure;+/! Switch the Do key back to accept LSE commandstprocedure vte_set_do_lseditBlocal this_informational; ! Old setting of informational messages8this_informational := get_info(system, "informational");set(informational, off);Gdefine_key("vte_lse_command(0)", do, " lse_command", vte$map_standard);;if this_informational then set(informational, on);gendif;vte$x_lse_marker := "* ";fvte$x_do_vte := 0;vte$update_status_lines(0);e endprocedure;o l! Page 255,! Set a new language for the current buffer.!p ! Parameters:n1! language_name: Name of language to be selectede+procedure vte_set_language(; language_name)tFlocal current_right_margin, ! Setting of right margin before execution= formatter_type, ! File type corresponding to formatterr, buffer_name; ! Name of current buffer)if language_name = tpu$k_unspecified thene if not vte$x_prompting thent3 vte$prompt_string("Language:", vte$kt_null, 1, 1);n if vte$x_display then return; endif;t endif;else) vte$x_prompt_result := language_name;eendif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null then( return;rendif;vte$x_repeatgIco VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>bIed := 0;vte$x_repeat_count := 1;&vte$set_language(vte$x_prompt_result);8vte$a_buffer_language{current_buffer} := vte$x_language; if current_right_margin = 0 thenE current_right_margin := get_info(current_buffer, "right_margin");tendif;vte$update_status_lines(0);p endprocedure;n u! Page 256L! Set the source directory search list. This list is preceded by the currentJ! directory and followed by the current CMS library, unless the command is)! given with a negative numeric argument.o!h ! Parameters:l!! dirspec: Search list to be setr#procedure vte_set_source(; dirspec) #if dirspec = tpu$k_unspecified then; if not vte$x_prompting theni? vte$prompt_string("Directory:", vte$x_source_directory, 1, 1);i return; endif;else# vte$x_prompt_result := dirspec;_endif;,edit(vte$x_prompt_result, trim, upper, off);)if vte$x_prompt_result = vte$kt_null then return;!endif;if vte$x_repeat_count >= 0 thenpI vte$x_source_directory := "[], " + vte$x_prompt_result + ", CMS$LIB";nelse2 vte$x_source_directory := vte$x_prompt_result;endif;vte$x_repeated := 0;vte$x_repeat_count := 1;7lse$do_command("Set Source " + vte$x_source_directory);n endprocedure;  i! Page 257! SCA support proceduresD! Search all occurrences of the token at the current cursor position!" ! Parameters:i8! select_value: Flag: -1 : references, 0 : declarations8procedure vte_find_symbol(; select_value) ! SCA support.local this_text, ! Symbol name to be searched& indicator, ! Possible qualifier0 sel_val; ! Local copy of input parameter(if select_value = tpu$k_unspecified then if vte$x_repeated then if vte$x_repeat_count < 0 thent sel_val := -1;= elsep sel_val := 0; endif;t vte$x_repeated := 0;  vte$x_repeat_count := 1;t else sel_val := 1; endif;else if select_value < 0 then sel_val := -1;e else sel_val := 0; endif;endif;this_text := vte$range;lif this_text = 0 thenn indicator := "/Indicated ";  this_text := vte$kt_null; else indicator := vte$kt_null;eendif;case sel_val from -1 to 1 M [-1]: lse$do_command("Find " + indicator + "/References " + this_text);O [0]: lse$do_command("Find " + indicator + "/Declarations " + this_text); < [1]: lse$do_command("Find " + indicator + this_text);endcase;update(current_window);"vte$adjust_windows;r'vte$set_status_line(vte$top_window, 0); *vte$set_status_line(vte$bottom_window, 0); endprocedure;t n! Page 258E! Search all declarations of the token at the current cursor positiono&procedure vte_find_symbol_declarationsvte_find_symbol(0); endprocedure;!C! Search all references of the token at the current cursor positiont$procedure vte_find_symbol_referencesvte_find_symbol(-1); endprocedure; ! Page 259I! Position to the declaration of the token at the current cursor positionc!i ! Parameters:o!/! mode_flag: Flag selecting type of operation:o'! 0 - select primary declaratione1! -1 - select context-dependent declarationn+procedure vte_goto_declaration(; mode_flag)i.local this_text, ! Symbol name to be searched& indicator, ! Possible qualifier5 selector, ! Qualifier for type of declarationl> this_position, ! Cursor position of item to be searchedD that_position; ! Cursor position of corresponding declarationselector := "/Primary ";%if mode_flag = tpu$k_unspecified thene< if (not vte$x_repeated) or (vte$x_repeat_count < 0) then selector := "/Context ";" endif;else if mode_flag < 0 then selector := "/Context "; endif;endif;vte$x_repeated := 0;vte$x_repeat_count := 1;this_text := vte$range; if this_text = 0 thene indicator := "/Indicated ";  this_text := vte$kt_null;Kelse indicator := vte$kt_null;endif;this_position := mark(none);Glse$do_command("Goto Declaration " + indicator + selector + this_text);ethat_position := mark(none); update(all);vte$adjust_windows;" endprocedure;cH! Position to the primary declaration of the token at the current cursor ! position&procedure vte_goto_declaration_primaryvte_goto_declaration(0); endprocedure;s endmodule; e! Page 260! Initialization proceduresoM! Define standard key definitions - control keys, arrow keys, e- and f- keys.iC! This procedure is not available from VTEDIT after initialization.J! Leading spaces in comment field are used to indicate VTEDIT-supplied keyM! definitions - do not use in user-written key definitions or for typing keys 8procedure vte$standard_keys ! Initialization procedures.! Setup variables needed for keymap definitionvte$init_variables;6-! Create key maps to hold the key definitions"1vte$map_basic := create_key_map("vte$map_basic");7vte$map_standard := create_key_map("vte$map_standard");s3vte$map_indent := create_key_map("vte$map_indent");1vte$map_flash := create_key_map("vte$map_flash");"1vte$map_match := create_key_map("vte$map_match"); ! Create keymap listsaCvte$list_cmd := create_key_map_list("vte$list_cmd", vte$map_basic);Evte$list_all := create_key_map_list("vte$list_all", vte$map_standard,(A vte$map_indent, vte$map_flash, vte$map_match, vte$map_basic);nEvte$list_doc := create_key_map_list("vte$list_doc", vte$map_standard,# vte$map_indent, vte$map_basic);fEvte$list_for := create_key_map_list("vte$list_for", vte$map_standard,g2 vte$map_indent, vte$map_flash, vte$map_basic);Evte$list_mar := create_key_map_list("vte$list_mar", vte$map_standard,f" vte$map_flash, vte$map_basic);Evte$list_nil := create_key_map_list("vte$list_nil", vte$map_standard,( vte$map_basic);tJ! Define default insertion procedure for all keymap lists except "Command"1set(undefined_key, vte$list_cmd, vte$bad_window);p5set(undefined_key, vte$list_all, vte$default_insert);x5set(undefined_key, vte$list_doc, vte$default_insert);u5set(undefined_key, vte$list_for, vte$default_insert);e5set(undefined_key, vte$list_mar, vte$default_insert);o5set(undefined_key, vte$list_nil, vte$default_insert);dH! Force explicit insertion control for all keymap lists except "Command"$set(self_insert, vte$list_all, off);$set(self_insert, vte$list_doc, off);$set(self_insert, vte$list_for, off);$set(self_insert, vte$list_mar, off);$set(self_insert, vte$list_nil, off);;! Fallback in case we get into a dynamically created bufferfJadd_key_map("tpu$key_map_list", "first", vte$map_basic, vte$map_standard); ! Arrow keys?define_key("vte_move_left", left, " move_left", vte$map_basic);1Bdefine_key("vte_move_right", right, " move_right", vte$map_basic);?define_key("vte_move_down", down, " move_down", vte$map_basic);l9define_key("vte_move_up", up, " move_up", vte$map_basic);nNdefine_key("vte_previous_screen", key_name(up, shift_key), " previous_screen", vte$map_basic);eHdefine_key("vte_next_screen", key_name(down, shift_key), " next_screen", vte$map_basic);eFdefine_key("vte_shift_left", key_name(left, shift_key), " shift_left", vte$map_standard);Idefine_key("vte_shift_right", key_name(right, shift_key), " shift_right",s vte$map_standard);! VT200 editing keypad keys)6define_key("vte_find", e1, " find", vte$map_standard);Bdefine_key("vte_substitute", e2, " substitute", vte$map_standard);7define_key("vte_remove", e3, " remove", vte$map_basic);n7define_key("vte_select", e4, " select", vte$map_basic);_Idefine_key("vte_previous_screen", e5, " previous_screen"h4 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>S, vte$map_basic);aAdefine_key("vte_next_screen", e6, " next_screen", vte$map_basic);p#! Shifted VT200 editing keypad keysrBdefine_key("vte_find_mark", key_name(e1, shift_key), " find_mark", vte$map_standard);Fdefine_key("vte_insert_mark", key_name(e2, shift_key), " insert_mark", vte$map_standard);Fdefine_key("vte_remove_mark", key_name(e3, shift_key), " remove_mark", vte$map_standard);=define_key("vte_select_rectangular", key_name(e4, shift_key),e- " select_rectangular", vte$map_standard);r! Top row function keys Ddefine_key("vte_next_buffer", f7, " next_buffer", vte$map_standard);Fdefine_key("vte_other_window", f8, " other_window", vte$map_standard);Jdefine_key("vte_change_windows", f9, " change_windows", vte$map_standard);7define_key("vte_exit", f10, " exit", vte$map_standard);lBdefine_key("vte_compile_tpu", f11, " compile_tpu", vte$map_basic);Bdefine_key("vte_end_of_line", f12, " end_of_line", vte$map_basic);>define_key("vte_line_feed", f13, " line_feed", vte$map_basic);Fdefine_key("vte_previous_page", f14, " previous_page", vte$map_basic);5define_key("vte_help", help, " help", vte$map_basic);l5define_key("vte_do(0)", do, " do", vte$map_standard);,;define_key("vte_attach", f17, " attach", vte$map_standard);l5define_key("vte_dcl", f18, " dcl", vte$map_standard); 9define_key("vte_spawn", f19, " spawn", vte$map_standard);i=define_key("vte_compile", f20, " compile", vte$map_standard);! Shifted top row function keyslHdefine_key("vte_list_buffers", key_name(f7, shift_key), " list_buffers", vte$map_standard);Gdefine_key("vte_execute_tpu", key_name(f11, shift_key), " execute_tpu",f vte$map_basic);mLdefine_key("vte_show", key_name(f12, shift_key), " show", vte$map_standard);Mdefine_key("vte_show", key_name(help, shift_key), " show", vte$map_standard);1Idefine_key("vte_tpu", key_name(do, shift_key), " tpu", vte$map_standard);m! Keys on main typing arrayrFdefine_key("vte_erase_previous_char", del_key, " erase_previous_char", vte$map_basic);t@define_key("vte_space", key_name(' '), " space", vte$map_basic);6define_key("vte_tab", tab_key, " tab", vte$map_basic);?define_key("vte_return", ret_key, " return", vte$map_standard);eEdefine_key("vte_end_of_line", bs_key, " end_of_line", vte$map_basic);_#! Shifted keys on main typing arraySGdefine_key("vte_expand_tabs", key_name(' ', shift_key), " expand_tabs",e vte$map_basic);)?define_key("vte_compress_spaces", key_name(tab_key, shift_key),t' " compress_spaces", vte$map_basic);iOdefine_key("vte_trim_trailing", key_name(ret_key, shift_key), " trim_trailing",  vte$map_basic);pOdefine_key("vte_show", key_name(bs_key, shift_key), " show", vte$map_standard);_Gdefine_key("vte_free_cursor", key_name('>', shift_key), " free_cursor",l vte$map_basic); Idefine_key("vte_bound_cursor", key_name('<', shift_key), " bound_cursor",a vte$map_basic); Idefine_key("vte_list_buffers", key_name(':', shift_key), " list_buffers",; vte$map_standard);! Control keysLdefine_key("vte_append_file", ctrl_a_key, " append_file", vte$map_standard);Idefine_key("vte_erase_previous_word", ctrl_b_key, " erase_previous_word",i vte$map_basic);eGdefine_key("vte_erase_line", ctrl_d_key, " erase_line", vte$map_basic);tEdefine_key("vte$copy_text('^E', 1)", ctrl_e_key, " execute_register",a vte$map_basic);wCdefine_key("vte_execute_register", ctrl_e_key, " execute_register",  vte$map_standard);Edefine_key("vte_next_word", ctrl_f_key, " next_word", vte$map_basic);;Cdefine_key("vte_include_register", ctrl_g_key, " include_register",f vte$map_basic);eEdefine_key("vte_line_feed", ctrl_j_key, " line_feed", vte$map_basic);f?define_key("vte_remove", ctrl_k_key, " remove", vte$map_basic);aEdefine_key("vte_form_feed", ctrl_l_key, " form_feed", vte$map_basic);lJdefine_key("vte$copy_text('^N', 1)", ctrl_n_key, " count", vte$map_basic);@define_key("vte_count", ctrl_n_key, " count", vte$map_standard);Mdefine_key("vte_save_register", ctrl_p_key, " save_register", vte$map_basic);;Mdefine_key("vte_previous_word", ctrl_r_key, " previous_word", vte$map_basic);eKdefine_key("vte_cut_register", ctrl_t_key, " cut_register", vte$map_basic);FIdefine_key("vte_erase_start_of_line", ctrl_u_key, " erase_start_of_line",  vte$map_basic);_Adefine_key("vte_display_control", ctrl_v_key, " display_control",b vte$map_standard);Adefine_key("vte_refresh", ctrl_w_key, " refresh", vte$map_basic);h;define_key("vte$quit", ctrl_z_key, " quit", vte$map_basic);eHdefine_key("vte_insert_numeric", key_name(ascii(28)), " insert_numeric", vte$map_basic); Bdefine_key("vte_insert_date", key_name(ascii(29)), " insert_date", vte$map_basic);y! Shifted control keysBdefine_key("vte_erase_next_word", key_name(ctrl_b_key, shift_key),' " erase_next_word", vte$map_basic);r@define_key("vte_delete_buffer", key_name(ctrl_d_key, shift_key),( " delete_buffer", vte$map_standard);Cdefine_key("vte_iterate_register", key_name(ctrl_e_key, shift_key),c( " iterate_register", vte$map_basic);Jdefine_key("vte_set_flash", key_name(ctrl_f_key, shift_key), " set_flash", vte$map_basic);p@define_key("vte_sort", key_name(ctrl_k_key, shift_key), " sort", vte$map_standard);Jdefine_key("vte_what_line", key_name(ctrl_n_key, shift_key), " what_line", vte$map_standard);Jdefine_key("vte_set_match", key_name(ctrl_r_key, shift_key), " set_match", vte$map_basic);aLdefine_key("vte_set_modify", key_name(ctrl_t_key, shift_key), " set_modify", vte$map_basic);eMdefine_key("vte$cancel", key_name(ctrl_u_key, shift_key), "", vte$map_basic);t=define_key("vte_set_scroll", key_name(ctrl_v_key, shift_key), % " set_scroll", vte$map_standard);wJdefine_key("vte_set_write", key_name(ctrl_w_key, shift_key), " set_write", vte$map_basic);o@define_key("vte_exit", key_name(ctrl_z_key, shift_key), " exit", vte$map_standard);Adefine_key("vte_quote", key_name(ascii(28), shift_key), " quote",d vte$map_basic);eMdefine_key("vte_insert_time", key_name(ascii(29), shift_key), " insert_time",( vte$map_basic);ePdefine_key("vte_tpu", key_name(ascii(31), shift_key), " tpu", vte$map_standard);! Shifted keysIdefine_key("vte_include_file", key_name('A', shift_key), " include_file",h vte$map_standard);Gdefine_key("vte_two_windows", key_name('B', shift_key), " two_windows",i vte$map_standard);Idefine_key("vte_other_window", key_name('C', shift_key), " other_window",t vte$map_standard);Edefine_key("vte_one_window", key_name('D', shift_key), " one_window", vte$map_standard);Kdefine_key("vte_set_formatter", key_name('E', shift_key), " set_formatter",e vte$map_basic);aGdefine_key("vte_set_journal", key_name('F', shift_key), " set_journal",l vte$map_basic);tOdefine_key("vte_set_search_case", key_name('G', shift_key), " set_search_case",v vte$map_basic); Idefine_key("vte_help", key_name('H', shift_key), " help", vte$map_basic);aPdefine_key("vte_attach", key_name('I', shift_key), " attach", vte$map_standard);Jdefine_key("vte_dcl", key_name('J', shift_key), " dcl", vte$map_standard);=define_key("vte_set_search_origin", key_name('K', shift_key),i) " set_search_origin", vte$map_basic);dKdefine_key("vte_learn", key_name('L', shift_key), " learn", vte$map_basic);tOdefine_key("vte_set_left_margin", key_name('M', shift_key), " set_left_margin",p vte$map_standard);Kdefine_key("vte_get_next_word", key_name('N', shift_key), " get_next_word",o vte$map_basic);lGdefine_key("vte_center_line", key_name('O', shift_key), " center_line",n vte$map_basic);oih7 VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>PIdefine_key("vte_fill", key_name('P', shift_key), " fill", vte$map_basic);eOdefine_key("vte_capitalize_word", key_name('Q', shift_key), " capitalize_word",, vte$map_basic);$Adefine_key("vte_set_tabs", key_name('R', shift_key), " set_tabs",( vte$map_basic);oNdefine_key("vte_spawn", key_name('S', shift_key), " spawn", vte$map_standard);?define_key("vte_set_word_delimiters", key_name('T', shift_key),+ " set_word_delimiters", vte$map_basic);Idefine_key("vte_store_number", key_name('U', shift_key), " store_number",  vte$map_basic);!Cdefine_key("vte_lowercase", key_name('V', shift_key), " lowercase",  vte$map_basic);lCdefine_key("vte_uppercase", key_name('W', shift_key), " uppercase",e vte$map_basic);g;define_key("vte_execute_learned", key_name('X', shift_key), 0 " execute_learned_sequence", vte$map_basic);Ldefine_key("vte_menu", key_name('Y', shift_key), " menu", vte$map_standard);Gdefine_key("vte_change_case", key_name('Z', shift_key), " change_case",i vte$map_basic); Mdefine_key("vte_umlaut", key_name('"', shift_key), " umlaut", vte$map_basic);uGdefine_key("vte_compile_tpu", key_name('.', shift_key), " compile_tpu",  vte$map_basic);_Gdefine_key("vte_execute_tpu", key_name(',', shift_key), " execute_tpu",p vte$map_basic); ! Keypad keysn>define_key("vte_next_line", kp0, " next_line", vte$map_basic);2define_key("vte_top", kp1, " top", vte$map_basic);8define_key("vte_bottom", kp2, " bottom", vte$map_basic);Fdefine_key("vte_start_of_line", kp3, " start_of_line", vte$map_basic);Fdefine_key("vte_previous_line", kp4, " previous_line", vte$map_basic);Jdefine_key("vte_erase_next_char", kp5, " erase_next_char", vte$map_basic);:define_key("vte_restore", kp6, " restore", vte$map_basic);@define_key("vte_split_line", kp7, " split_line", vte$map_basic);>define_key("vte_next_page", kp8, " next_page", vte$map_basic);4define_key("vte_mark", kp9, " mark", vte$map_basic);4define_key("vte_save", pf2, " save", vte$map_basic);6define_key("vte_paste", pf3, " paste", vte$map_basic);=define_key("vte_replace", pf4, " replace", vte$map_standard);l9define_key("vte_find", enter, " find", vte$map_standard);Ddefine_key("vte_find_next", period, " find_next", vte$map_standard);Adefine_key("vte_exchange", comma, " exchange", vte$map_standard);hAdefine_key("vte_set_mode", minus, " set_mode", vte$map_standard); ! Shifted keypad keyslCdefine_key("vte_scroll_up", key_name(kp0, shift_key), " scroll_up",o vte$map_basic);SCdefine_key("vte_read_file", key_name(kp1, shift_key), " read_file",n vte$map_standard);Edefine_key("vte_write_file", key_name(kp2, shift_key), " write_file",a vte$map_standard);Pdefine_key("vte_buffer", key_name(kp3, shift_key), " buffer", vte$map_standard);Gdefine_key("vte_scroll_down", key_name(kp4, shift_key), " scroll_down",e vte$map_basic);tCdefine_key("vte_formatter", key_name(kp5, shift_key), " formatter",  vte$map_standard);Edefine_key("vte_skip_range", key_name(kp6, shift_key), " skip_range",l vte$map_basic);eGdefine_key("vte_file_search", key_name(kp7, shift_key), " file_search",e vte$map_standard);Edefine_key("vte_close_file", key_name(kp8, shift_key), " close_file",a vte$map_standard);>define_key("vte_select_rectangular", key_name(kp9, shift_key),* " select_rectangular", vte$map_basic);Gdefine_key("vte_write_range", key_name(pf2, shift_key), " write_range",s vte$map_standard);Cdefine_key("vte_this_file", key_name(pf3, shift_key), " this_file",  vte$map_standard);Gdefine_key("vte_replace_all", key_name(pf4, shift_key), " replace_all",a vte$map_standard);Gdefine_key("vte_substitute", key_name(enter, shift_key), " substitute",t vte$map_standard);Fdefine_key("vte_find_mark", key_name(period, shift_key), " find_mark", vte$map_standard);Idefine_key("vte_toggle_mark", key_name(comma, shift_key), " toggle_mark",e vte$map_standard);Cdefine_key("vte_set_case", key_name(minus, shift_key), " set_case",s vte$map_basic);a! Numeric argumentsfPdefine_key("vte$repeat_count(0)", key_name('0', shift_key), " numeric_argument", vte$map_basic);oPdefine_key("vte$repeat_count(1)", key_name('1', shift_key), " numeric_argument", vte$map_basic);bPdefine_key("vte$repeat_count(2)", key_name('2', shift_key), " numeric_argument", vte$map_basic);oPdefine_key("vte$repeat_count(3)", key_name('3', shift_key), " numeric_argument", vte$map_basic); Pdefine_key("vte$repeat_count(4)", key_name('4', shift_key), " numeric_argument", vte$map_basic);iPdefine_key("vte$repeat_count(5)", key_name('5', shift_key), " numeric_argument", vte$map_basic); Pdefine_key("vte$repeat_count(6)", key_name('6', shift_key), " numeric_argument", vte$map_basic);dPdefine_key("vte$repeat_count(7)", key_name('7', shift_key), " numeric_argument", vte$map_basic);"Pdefine_key("vte$repeat_count(8)", key_name('8', shift_key), " numeric_argument", vte$map_basic);sPdefine_key("vte$repeat_count(9)", key_name('9', shift_key), " numeric_argument", vte$map_basic);s<define_key("vte$repeat_count(16)", key_name('^', shift_key),( " numeric_argument", vte$map_basic);<define_key("vte$repeat_count(17)", key_name('+', shift_key),( " numeric_argument", vte$map_basic);<define_key("vte$repeat_count(18)", key_name('-', shift_key),( " numeric_argument", vte$map_basic);! Keys terminating prompting@define_key("vte$exit_command_window", do, " do", vte$map_basic);Idefine_key("vte$exit_command_window", ret_key, " return", vte$map_basic);pKdefine_key("vte$exit_command_window", period, " find_next", vte$map_basic); Edefine_key("vte$exit_command_window", enter, " find", vte$map_basic);cBdefine_key("vte$exit_command_window", e1, " find", vte$map_basic);! Indentation control keysCdefine_key("vte_indent", key_name('.'), " indent", vte$map_indent);iOdefine_key("vte_reset_indent", key_name('='), " reset_indent", vte$map_indent); Mdefine_key("vte_indent_more", key_name('>'), " indent_more", vte$map_indent);_Mdefine_key("vte_indent_less", key_name('<'), " indent_less", vte$map_indent);=Ddefine_key("vte_increase_indent", key_name('+'), " increase_indent", vte$map_indent);Ddefine_key("vte_decrease_indent", key_name('-'), " decrease_indent", vte$map_indent);Ldefine_key("vte_indent_continuation", key_name('*'), " indent_continuation", vte$map_indent);Cdefine_key("vte$insert_colon", key_name(':'), ':', vte$map_indent);$Ddefine_key("vte$insert_dollar", key_name('$'), '$', vte$map_indent);8! Opening parentheses - may be matched with closing onesAdefine_key("vte$insert_matched('(')", key_name('('), vte$kt_null,_ vte$map_match);dAdefine_key("vte$insert_matched('[')", key_name('['), vte$kt_null,m vte$map_match);"Adefine_key("vte$insert_matched('<')", key_name('<'), vte$kt_null,r vte$map_match);lAdefine_key("vte$insert_matched('{')", key_name('{'), vte$kt_null,v vte$map_match);(Adefine_key("vte$insert_matched('')", key_name(''), vte$kt_null,e vte$map_match);dCdefine_key("vte$insert_matched('''')", key_name(''''), vte$kt_null,) vte$map_match);,Bdefine_key("vte$insert_matched('""')", key_name('"'), vte$kt_null, vte$map_match);)@! Closing parentheses - may flash the corresponding opening onesBdefine_key("vte$insert_flashing(')')", key_name(')'), vte$kt_null, vte$map_flash);eBdefine_key("vte$insert_flashing(']')", key_name(']'), vte$kt_null, vte$map_flash);,Bdefine_key("vte$insert_flashing('>')", key_name('>'), vte$kt_null, vte$map_flash);dBdefine_key("vte$insert_flashing('}')", key_name('}jl VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>j'), vte$kt_null, vte$map_flash);Bdefine_key("vte$insert_flashing('')", key_name(''), vte$kt_null, vte$map_flash);rDdefine_key("vte$insert_flashing('''')", key_name(''''), vte$kt_null, vte$map_flash);"Cdefine_key("vte$insert_flashing('""')", key_name('"'), vte$kt_null,_ vte$map_flash);" ! Mouse keysOdefine_key("vte$$mouse_position", m1down, " mouse_position", vte$map_standard);y7define_key(vte$null, m1up, vte$kt_null, vte$map_basic);eKdefine_key("vte$$mouse_select", m2down, " mouse_select", vte$map_standard);_Ldefine_key("vte$$mouse_operation", m2up, " mouse_operation", vte$map_basic);Idefine_key("vte$$mouse_paste", m3down, " mouse_paste", vte$map_standard);07define_key(vte$null, m3up, vte$kt_null, vte$map_basic);n endprocedure;a ;! Page 261I! Procedure to set up key definitions for LSE support - must be called ate*! most once (during VTEDIT initialization)procedure vte$lse_keys0! Create key map to hold the LSE key definitions-vte$map_lse := create_key_map("vte$map_lse");e#! Shifted VT200 editing keypad keyse?define_key("vte_previous_placeholder", key_name(e5, shift_key),i/ " previous_placeholder", vte$map_standard);";define_key("vte_next_placeholder", key_name(e6, shift_key),m+ " next_placeholder", vte$map_standard);,! Top row function keyseGdefine_key("vte_expand_token", f13, " expand_token", vte$map_standard);tGdefine_key("vte_lse_command(0)", do, " lse_command", vte$map_standard);_! Shifted top row function keysv;define_key("vte_goto_declaration", key_name(f8, shift_key),t+ " goto_declaration", vte$map_standard);tFdefine_key("vte_find_symbol", key_name(f9, shift_key), " find_symbol", vte$map_standard);Adefine_key("vte_lse_keys", key_name(f13, shift_key), " lse_keys",e vte$map_standard);Pdefine_key("vte_review", key_name(f14, shift_key), " review", vte$map_standard);=define_key("vte_erase_placeholder", key_name(f17, shift_key),,, " erase_placeholder", vte$map_standard);Gdefine_key("vte_goto_source", key_name(f18, shift_key), " goto_source"," vte$map_standard);Kdefine_key("vte_previous_step", key_name(f19, shift_key), " previous_step"," vte$map_standard);Cdefine_key("vte_next_step", key_name(f20, shift_key), " next_step",s vte$map_standard);! Keys on main typing arraysBdefine_key("vte$insert_hash", key_name('#'), '#', vte$map_indent);#! Shifted keys on main typing arrayiKdefine_key("vte_previous_step", key_name('[', shift_key), " previous_step",_ vte$map_standard);Cdefine_key("vte_next_step", key_name(']', shift_key), " next_step"," vte$map_standard);Gdefine_key("vte_goto_source", key_name('*', shift_key), " goto_source",t vte$map_standard);=define_key("vte_erase_placeholder", key_name('#', shift_key),k, " erase_placeholder", vte$map_standard);Pdefine_key("vte_set_do", key_name('$', shift_key), " set_do", vte$map_standard);<define_key("vte_next_placeholder", key_name(')', shift_key),+ " next_placeholder", vte$map_standard);,@define_key("vte_previous_placeholder", key_name('(', shift_key),/ " previous_placeholder", vte$map_standard);_Kdefine_key("vte_language_help", key_name('?', shift_key), " language_help",e vte$map_standard);Pdefine_key("vte_review", key_name('=', shift_key), " review", vte$map_standard);Gdefine_key("vte_find_symbol", key_name("'", shift_key), " find_symbol",f vte$map_standard);<define_key("vte_goto_declaration", key_name(';', shift_key),+ " goto_declaration", vte$map_standard);a! Control keysNdefine_key("vte_expand_token", ctrl_j_key, " expand_token", vte$map_standard);Hdefine_key("vte_lse_command(1)", us_key, " lse_mode", vte$map_standard);! Control keys overlayKdefine_key("vte_previous_step", ctrl_b_key, " previous_step", vte$map_lse);"6define_key("vte_goto_declaration_primary", ctrl_d_key,. " goto_declaration_primary", vte$map_lse);Idefine_key("vte_expand_token", ctrl_e_key, " expand_token", vte$map_lse);,Cdefine_key("vte_next_step", ctrl_f_key, " next_step", vte$map_lse);eGdefine_key("vte_goto_source", ctrl_g_key, " goto_source", vte$map_lse);eEdefine_key("vte_erase_placeholder", ctrl_k_key, " erase_placeholder",i vte$map_lse);)Cdefine_key("vte_next_placeholder", ctrl_n_key, " next_placeholder",a vte$map_lse);"Kdefine_key("vte_previous_placeholder", ctrl_p_key, " previous_placeholder",) vte$map_lse);_Gdefine_key("vte_lse_command(1)", ctrl_z_key, " lse_mode", vte$map_lse);d! Shifted control keysPdefine_key("vte_define_alias", key_name(ctrl_a_key, shift_key), " define_alias", vte$map_standard);Cdefine_key("vte_goto_declaration", key_name(ctrl_d_key, shift_key),k& " goto_declaration", vte$map_lse);@define_key("vte_comment_align", key_name(ctrl_g_key, shift_key),( " comment_align", vte$map_standard);Hdefine_key("vte_lse_keys", key_name(ctrl_j_key, shift_key), " lse_keys", vte$map_standard);Ldefine_key("vte_set_source", key_name(ctrl_l_key, shift_key), " set_source", vte$map_standard);Pdefine_key("vte_comment_fill", key_name(ctrl_p_key, shift_key), " comment_fill", vte$map_standard);! Shifted control keys overlayIdefine_key("lse$do_command('Unexpand')", key_name(ctrl_e_key, shift_key)," " unexpand", vte$map_lse);Hdefine_key("lse$do_command('Unerase Placeholder')", key_name(ctrl_k_key,5 shift_key), " unerase_placeholder", vte$map_lse);$ endprocedure; i! Page 262! MAIN INITIALIZATION PROCEDURE_!iI! Invoked to initialize the editing session. The windows and buffers arek! created here.mprocedure vte$init_procedure4local output_file_name, ! Original output file name> parsed_output_file_name, ! Full filespec for output file0 input_file_name, ! Filespec of input file= input_file_name_type, ! The same without version numbersB input_file_name_only, ! No node, disk, directory, or version6 input_file_type, ! File extension of input file: window_line, ! Loop index to initialize init window. screen_length, ! Number of screen lines/ screen_width, ! Number of screen columnse; init_buffer, ! Buffer containing initialization texti1 init_window, ! Window to display this texth; help_position, ! Marker for Help info in init windowh7 edit_string, ! String announcing mode of editing? time_position, ! Marker for timer message in init window_9 help_range, ! Highlighted Help info in init windowi= time_range, ! Highlighted timer message in init window_5 current_time, ! Actual time as 3-digit integer,8 time_string, ! Actual time as standard VMS string7 time_msg1, ! First part of time-dpendent message)8 time_msg2, ! Second part of time-dpendent message: window_width, ! Width to be used for system windows8 window_top, ! Current top line of several windows> window_bottom, ! Current bottom line of several windows: loop_window, ! Variable to loop through all windows8 loop_buffer, ! Buffer corresponding to the window7 init_prog; ! Program resulting from command fileaon_error" if error = tpu$_parsefail then6 message(fao("Don't understand output file name: !AS", output_file_name)); endif; endon_error;! Initialize our variables*if vte$x_running <> tpu$k_unspecified then if vte$x_running > 0 then)( message("Initialization already done"); return; endif;endif;1if get_info(system, "facility_name") = "LSE" thent vte$x_lse_support := 1;"else vte$x_lse_support := 0;tendif;vte$init_variables;$Jif (not vtkx VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>#e$x_lse_support) and ((not get_info(command_line, "display")) or) (not get_info(screen, "ansi_crt"))) theni vte$x_display := 0; endif;$if get_info(screen, "dec_crt2") then vte$x_vt200_keypad := 1; if vte$x_lse_support thene set(mouse, on); endif;endif;! Disable Ctrl/Tif vte$x_display then,> time_msg1 := call_user(vte$k_disable_ctrl_t, vte$kt_null);# ! Set up initialization display,8 screen_length := get_info(screen, "visible_length");7 screen_width := get_info(screen, "original_width");y! window_width := screen_width;'. if window_width > vte$k_narrow_window then% window_width := vte$k_narrow_window;e endif;C init_buffer := vte$init_buffer("$Initialize", vte$kt_null, -1);" window_line := 1;e position(init_buffer); loop( exitif window_line > screen_length - 2; split_line; window_line := window_line + 1; endloop;< init_window := create_window(1, screen_length - 2, off);" map(init_window, init_buffer); position(init_window);endif;P! Create message buffer/window, or, in LSE mode, adjust it and the prompt windowif vte$x_lse_support thene# set(permanent, message_buffer);e) message_window := lse$message_window;y4 set(key_map_list, vte$list_nil, message_window);: window_top := get_info(message_window, "visible_top");@ window_bottom := get_info(message_window, "visible_bottom");M adjust_window(message_window, screen_length - window_top, screen_length -r window_bottom);A vte$prompt_buffer := vte$init_buffer("$Prompts", vte$kt_null,o vte$x_lse_support);+ vte$prompt_window := eve$prompt_window;i( set(video, vte$prompt_window, none);. map(vte$prompt_window, vte$prompt_buffer);= window_top := get_info(vte$prompt_window, "visible_top");eC window_bottom := get_info(vte$prompt_window, "visible_bottom");tD adjust_window(vte$prompt_window, screen_length - window_top - 1,$ screen_length - window_bottom - 1); unmap(vte$prompt_window); else if vte$x_display then_@ message_buffer := vte$init_buffer("$Messages", vte$kt_null, 0);8 message_window := create_window(screen_length, 1, off); endif;endif;if vte$x_display thenk( map(message_window, message_buffer);; set(max_lines, message_buffer, vte$k_max_buffer_lines);n- set(width, message_window, window_width);eendif;!! Display initialization messages,if vte$x_display then( position(beginning_of(init_buffer));' move_vertical(screen_length/2 - 4);l if vte$x_lse_support thene move_vertical(-1);k' copy_text(' ' * (screen_width/2 - 9));i! copy_text("Language Sensitive");t move_vertical(1); endif;+ copy_text(' ' * (screen_width/2 - 10));_, copy_text(substr(vte$x_version, 1, 20)); move_vertical(2);,+ copy_text(' ' * (screen_width/2 - 10));k/ time_string := substr(fao("!%D",0), 1, 20);s+ time_msg1 := substr(time_string, 5, 2);e" change_case(time_msg1, lower);L copy_text(substr(time_string, 1, 4) + time_msg1 + substr(time_string, 7, 14)); move_vertical(8);" if vte$x_vt200_keypad then( copy_text(' ' * (screen_width/2 - 12)); move_horizontal(-1); help_position := mark(none);e move_horizontal(+1);$( copy_text('For help press "Help" key'); else( copy_text(' ' * (screen_width/2 - 11)); move_horizontal(-1);  help_position := mark(none);  move_horizontal(+1);y& copy_text('For help type " H"'); endif;@ help_range := create_range(help_position, mark(none), bold);% ! Display time-dependent messagesf! time_string := fao("!%T", 0);e9 current_time := int(substr(time_string, 1, 2)) * 10 +l int(substr(time_string, 4, 1));# case current_time from 0 to 240i, [0,1,2]: time_msg1 := "Are you crazy?";+ time_msg2 := "It's after midnight.";e/ [40,41,42]: time_msg1 := "Esta muy loco?";k, time_msg2 := "You should be in bed.";/ [83,84,85]: time_msg1 := "The early bird";"' time_msg2 := "only gets worms.";,- [115,120,121,122]: time_msg1 := "Go away.";y+ time_msg2 := "It's time for lunch."; 9 [170,171,172]: time_msg1 := "Ding-a-ling-a-ling...";s0 time_msg2 := "This terminal is alarmed!"; set(bell, all, on); message(vte$kt_null); message(vte$kt_null); set(bell, all, off);v4 [213,214,215]: time_msg1 := "I am very tired.";+ time_msg2 := "Please let me sleep.";_4 [235]: time_msg1 := "It's almost midnight..."; time_msg2 := vte$kt_null; [inrange,) outrange]: time_msg1 := vte$kt_null;p time_msg2 := vte$kt_null; endcase;$ if time_msg1 <> vte$kt_null then% position(beginning_of(init_buffer));" move_vertical(screen_length/2); move_horizontal(-1);e time_position := mark(none);n move_horizontal(1); copy_text(time_msg1);! if time_msg2 <> vte$kt_null thenh move_vertical(1); copy_text(time_msg2); endif;y> time_range := create_range(time_position, mark(none), blink); endif; update(init_window); set(screen_update,off);uendif;2! Turn off message headers(facility, severity, id)set(message_flags, 1);set(message_action_level, 2);eif not vte$x_lse_support thenu# set(message_action_type, bell);kendif;! Setup cursor movement'set(column_move_vertical, on);set(pad_overstruck_tabs,on);*! Create all the necessary default buffers@vte$vtedit_buffer := vte$init_buffer("$VTEDIT", vte$kt_null, 0);:vte$dcl_buffer := vte$init_buffer("$DCL", vte$kt_null, 0);:vte$tpu_buffer := vte$init_buffer("$TPU", vte$kt_null, 0);@vte$search_buffer := vte$init_buffer("$Search", vte$kt_null, 0);@vte$target_buffer := vte$init_buffer("$Target", vte$kt_null, 0);Bvte$restore_buffer := vte$init_buffer("$Restore", vte$kt_null, 0);Bvte$replace_buffer := vte$init_buffer("$Replace", vte$kt_null, 0);@vte$memory_buffer := vte$init_buffer("$Memory", vte$kt_null, 0);Evte$initial_buffer := vte$init_buffer("$Init$File$", vte$kt_null, 0);eHvte$local_init_buffer := vte$init_buffer("$Local$Ini$", vte$kt_null, 1);Fvte$directory_buffer := vte$init_buffer("$Directory", vte$kt_null, 0);Avte$buffer_buffer := vte$init_buffer("$Buffers", vte$kt_null, 0);t+set(modifiable, vte$directory_buffer, off);i(set(modifiable, vte$buffer_buffer, off);Hhelp_buffer := vte$init_buffer("$Help", vte$kt_null, vte$x_lse_support);Hshow_buffer := vte$init_buffer("$Show", vte$kt_null, vte$x_lse_support);Nvte$paste_buffer := vte$init_buffer("$Paste", vte$kt_null, vte$x_lse_support);=vte$match_buffer := vte$init_buffer("$Matches$", vte$kt_null,a vte$x_lse_support);d>vte$choice_buffer := vte$init_buffer("$Choices$", vte$kt_null, vte$x_lse_support);a?vte$command_buffer := vte$init_buffer("$Commands", vte$kt_null,p vte$x_lse_support); 4set(key_map_list, vte$list_cmd, vte$command_buffer);if vte$x_lse_support theni@ add_key_map("eve$command_map_list", "first", vte$map_basic);@ add_key_map("lse$cmd_key_map_list", "first", vte$map_basic);G vte$lse_buffer := vte$init_buffer("$Recall$Line$", vte$kt_null, 1);'; set(max_lines, vte$lse_buffer, vte$k_max_buffer_lines);eelseD vte$prompt_buffer := vte$init_buffer("$Prompt", vte$kt_null, 0);endif;! Create the prompt areaif vte$x_display then if vte$x_lse_support theny. set(prompt_area, screen_length - 1, 1, none); endif;1 set(prompt_area, screen_length - 1, 1, bold);t$ set(timer, on, "...working...");endif;%! Turn on bell for broadcast messageseset(bell, broadcast, on);! Create the needed windowseif vte$x_display thensCl* VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>!/ vte$command_window := create_window(screen_length - 1, 1, off);_1 set(width, vte$command_window, window_width);h0 map(vte$command_window, vte$command_buffer);; info_window := create_window(1, screen_length - 2, on);,* set(width, info_window, window_width);M set(scrolling, info_window, on, screen_length/2 - 2, screen_length/2 - 2,) 0);< ! Create windows for top and bottom halves of the screen; ! Top window may be one line longer than bottom window.,2 vte$x_main_window_length := screen_length - 2;? vte$x_bottom_window_length := vte$x_main_window_length / 2;,9 vte$x_top_window_length := vte$x_main_window_length -  vte$x_bottom_window_length;J vte$x_maximum_windows := (get_info(screen, "visible_length") - 2) / 3;@ vte$a_windows := create_array(vte$x_maximum_windows + 1, 0);! if not vte$x_lse_support then,C vte$main_window := create_window(1, vte$x_main_window_length, on);A vte$top_window := create_window(1, vte$x_top_window_length, on);m@ vte$bottom_window := create_window(vte$x_top_window_length + 1,% vte$x_bottom_window_length, on);n+ set(width, vte$main_window, window_width);e* set(width, vte$top_window, window_width);- set(width, vte$bottom_window, window_width);e. set(scrolling, vte$main_window, on, 3, 3, 0);- set(scrolling, vte$top_window, on, 3, 3, 0);e0 set(scrolling, vte$bottom_window, on, 3, 3, 0); else$ vte$main_window := lse$main_window;" vte$top_window := lse$top_window;( vte$bottom_window := lse$bottom_window; vte$adjust_windows; endif;( vte$a_windows{0} := vte$main_window;' vte$a_windows{1} := vte$top_window;i* vte$a_windows{2} := vte$bottom_window;B ! Create choice window to fit into a part of the bottom windowA vte$x_choice_window_length := vte$x_bottom_window_length - 2; : if vte$x_choice_window_length < screen_length / 4 then1 vte$x_choice_window_length := screen_length / 4;r endif;C vte$choice_window := create_window(vte$x_top_window_length + 3,a! vte$x_choice_window_length, on);e0 set(width, vte$choice_window, window_width);3 set(scrolling, vte$choice_window, on, 0, 0, 0);_; set(status_line, vte$choice_window, bold, vte$kt_null);iO set(status_line, vte$choice_window, reverse, " Position to a choice and " +,0 "press Select or Enter, or abort with Ctrl/Z");) vte$x_this_window := vte$main_window;d6 ! Create and/or change the windows for LSE support! if not vte$x_lse_support thend? vte$prompt_window := create_window(screen_length - 1, 1, off);o endif;0 set(width, vte$prompt_window, window_width);( set(video, vte$prompt_window, bold); if vte$x_lse_support thenk2 set(status_line, info_window, bold, vte$kt_null);8 set(status_line, info_window, reverse, " Show buffer"); endif;endif;8! Now for the main buffer. Create it from the input fileedit_string := "Editing";if vte$x_lse_support thenh@ input_file_name := get_info(eve$x_main_buffer, "file_name");) if input_file_name = vte$kt_null then"8 input_file_name := get_info(command_line, "file_name"); endif;; vte$x_wild_file := get_info(command_line, "file_name");rM if (index(vte$x_wild_file, '*') > 0) or (index(vte$x_wild_file, '%') > 0)00 or (index(vte$x_wild_file, "...") > 0) thenF vte$x_wild_result := file_search(vte$x_wild_file, "sys$disk:[]*.*;"); endif;else; input_file_name := get_info(command_line, "file_name");iendif;%if input_file_name = vte$kt_null thene if vte$x_lse_support then$) if get_info(system, "current_file") then ' input_file_name := vte$get_memory; endif;a else# input_file_name := vte$get_memory;_ endif;) vte$x_memory_file := input_file_name;n* if input_file_name <> vte$kt_null then edit_string := "Re-editing"; endif;endif;! Try to apply LSE defaultsyIinput_file_name_type := call_user(vte$k_translate_logical, "LSE$SOURCE");e+if input_file_name_type <> vte$kt_null theniE input_file_name_type := file_parse(input_file_name, "LSE$SOURCE",_ "sys$disk:[]*.*;");elseJ input_file_name_type := file_parse(input_file_name,"sys$disk:[]*.*;");endif;if vte$x_display thena set(screen_update, on);eendif;-! Try to find the (first) file matching input,&if input_file_name <> vte$kt_null then> input_file_name := vte$resolve_wild(input_file_name_type);) if input_file_name = vte$kt_null thena' message("No file selected - exiting");k if vte$x_display then update(message_window); endif;d exit; endif;else# input_file_name := vte$kt_null;_endif;,! Remove possible asterisks from file search&if input_file_name <> vte$kt_null thenD input_file_name_only := file_parse(input_file_name, vte$kt_null, vte$kt_null, name) - '*';L input_file_type := file_parse(input_file_name, vte$kt_null, vte$kt_null, type) - '*';oL input_file_name := file_parse(input_file_name, vte$kt_null, vte$kt_null,D node, device, directory) + input_file_name_only + input_file_type +@ file_parse(input_file_name, vte$kt_null, vte$kt_null, version);endif;<! If /NOCREATE is present and file does not exist, then exitNif (input_file_name <> vte$kt_null) and (not get_info(command_line, "create")) theneP if (input_file_name_only = vte$kt_null) and (input_file_name <> vte$kt_null) thene? message("Input file does not exist: " + input_file_name_only);_ if vte$x_display then update(message_window); endif;$ exit; endif;endif;input_file_type := vte$kt_null;a%if input_file_name = vte$kt_null then  if vte$x_lse_support thent" main_buffer := eve$x_main_buffer; else2 main_buffer := vte$create_buffer("$Main.", 0, 0); endif;( input_file_name_type := vte$kt_null;elseL input_file_type := file_parse(input_file_name, vte$kt_null, vte$kt_null, type);sD input_file_name_only := file_parse(input_file_name, vte$kt_null,& vte$kt_null, name) + input_file_type;D input_file_name_type := file_parse(input_file_name, vte$kt_null,3 vte$kt_null, node, device, directory, name, type); ' ! Display name of file being editedt if vte$x_display then % position(beginning_of(init_buffer));a if screen_length > 20 thenl( move_vertical(screen_length/2 - 9); endif;;+ if get_info(command_line,"read_only") thenl! edit_string := "Inspecting";h endif; @ copy_text(fao('!AS File "!AS"', edit_string, input_file_name));3 ! Display name of formatter selected for this filen; vte$x_formatter_name := vte$get_formatter(input_file_type,r vte$x_formatter_names);, if vte$x_formatter_name <> vte$kt_null then vte$x_formatter := 1;H vte$x_extended_formatter := vte$a_formatters{vte$x_formatter_name};4 if vte$x_extended_formatter <> vte$kt_null then move_vertical(1);eB copy_text(fao("Using !AS Formatter", vte$x_extended_formatter)); endif;, endif;y: ! Display message if we position to a remembered position; if (vte$x_first_line > 1) or (vte$x_first_column > 1) thend move_vertical(1);1 copy_text("Finding remembered position...");N endif;s update(init_window);t endif; if vte$x_lse_support thent? if get_info(eve$x_main_buffer, "file_name") = vte$kt_null thene, if vte$x_memory_file = vte$kt_null then: eve$x_main_buffer := create_buffer(input_file_name_only, input_file_name);,# main_buffer := eve$x_main_buffer;w else 4 main_buffer := create_buffer(input_file_name_only, input_file_name);g endif;r elsee& main_buffer := eve$x_main_buffer; endif;i elseE main_buffer := crmw VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>eate_buffer(input_file_name_only, input_file_name); endif;endif;)vte$x_input_file := input_file_name_type; G! The output file should be written to the current directory by defaultWF! unless there is another directory specified in the output_file_name.F! We need to use sys$disk:[] as the default file specification so thatE! the output file won't be written to the same directory as the inputsN! file if an input file directory is explicitly specified on the command line.J! We also DON'T want the node, device or directory of the input file, just ! the name.s,if not get_info(command_line, "output") then set(no_write, main_buffer); else. if get_info(command_line,"read_only") then set(no_write,main_buffer);p else; output_file_name := get_info(command_line, "output_file");a( if output_file_name <> vte$kt_null thenE input_file_name_only := file_parse(input_file_name, vte$kt_null,_ vte$kt_null, name, type);$< parsed_output_file_name := file_parse(output_file_name,' "sys$disk:[]", input_file_name_only);m3 if parsed_output_file_name <> vte$kt_null theni9 set(output_file, main_buffer, parsed_output_file_name);f/ vte$x_output_file := parsed_output_file_name;d endif;f elsel9 set(output_file, main_buffer, input_file_name_type); / vte$x_output_file := input_file_name_type;e endif;c endif;endif;Mif get_info(command_line, "nomodify") or (get_info(command_line, "read_only")n1 and (not get_info(command_line, "modify"))) thene& set(modifiable, main_buffer, off);endif;9! Create default buffer as a template for further bufferstif vte$x_lse_support theno- vte$default_buffer := eve$default_buffer;elseO vte$default_buffer := create_buffer("$Defaults", vte$kt_null, main_buffer);=8 set(key_map_list, vte$list_nil, vte$default_buffer);$ set(system, vte$default_buffer);' set(permanent, vte$default_buffer); endif;/set(eob_text, vte$default_buffer, vte$kt_null);l! Start journallingaif not vte$x_lse_support then " vte$journal_open(main_buffer);endif;7! Initialization is nearly finished - stop init displayoif vte$x_display thene! set(timer, off, vte$kt_null);m unmap(init_window);s delete(init_window); delete(init_buffer); position(vte$main_window);& map(vte$main_window, main_buffer); if vte$x_lse_support theni& adjust_window(vte$main_window, 0, 1); endif;endif;$position(beginning_of(main_buffer));?vte$a_left_margin{current_buffer} := vte$k_default_left_margin;tif vte$x_display theni< set(margins, main_buffer, 1, get_info(screen, "width") - vte$k_default_right_margin);pelse6 set(margins, main_buffer, 1, vte$k_narrow_window);endif;,set(eob_text, main_buffer, "[End of File]");(vte$set_status_line(vte$main_window, 1);if vte$x_lse_support thengK if (call_user(vte$k_translate_logical, "LSE$SOURCE") = vte$kt_null) andwH (call_user(vte$k_translate_logical, "CMS$LIB") <> vte$kt_null) then) vte$x_source_directory := "[], CMS$LIB";) lse$do_command("Set Source [], CMS$LIB") endif;endif;2if get_info(command_line, "start_record") > 1 then? vte$x_first_line := get_info(command_line, "start_record");sendif;5if get_info(command_line, "start_character") > 1 thenaD vte$x_first_column := get_info(command_line, "start_character");endif;:if (vte$x_first_line > 1) or (vte$x_first_column > 1) then if vte$x_first_line > 1 then% move_vertical(vte$x_first_line - 1); endif;" if vte$x_first_column > 1 then) move_horizontal(vte$x_first_column - 1);) endif;' vte$x_first_position := mark(none);eendif;&! If a command file was given, read it)if get_info(command_line, "command") then 5 input_file_name_type := file_search(vte$kt_null);C input_file_name_type := get_info(command_line, "command_file");k/ if input_file_name_type <> vte$kt_null thensI input_file_name_type := file_search(input_file_name_type, "VTE$COMMAND",l ".TPU");y else< input_file_name_type := file_search("VTE$COMMAND", ".TPU"); endif;endif;K! Call user's own initialization procedure, for initializing variables etc.1if not vte$x_lse_support thenl tpu$local_init;nendif;1! If an initialization file was given, execute itpLif (not vte$x_lse_support) and get_info(command_line, "initialization") then@ input_file_name_type := get_info(command_line, "init_file");. if input_file_name_type = vte$kt_null then9 input_file_name_type := file_search("VTE$INIT", ".VTE");o endif;/ if input_file_name_type <> vte$kt_null thenr$ vte__at_file(input_file_name_type); endif;endif;vte$x_running := 1;l5! In hardcopy mode, loop to read and execute commands if not vte$x_display then  vte$$line_mode; vte_exit; endif; endprocedure;  n! Page 263C! Define global constants and those variables that are needed earlyo*module vte$global_definitions ident "V5.1"! Global string constants 4constant vte$kt_version := ! VTEDIT version number "VTEDIT Version V5.1-037"; ?constant vte$kt_command_prefix := "vte_"; ! Routine name prefixi+constant vte$kt_null := ""; ! Null stringt7constant vte$kt_whitespace := ! Whitespace characters, ' ' + ascii(9);s<constant vte$kt_cont_space := ! Fortran continuation lines ' ' * 5; ! label field?constant vte$kt_cobol_space := ! Cobol comment lines sequencee ' ' * 6; ! number field;constant vte$kt_dcl_separators := ! Separators used in DCL:" "! " + ascii(9); ! commands=constant vte$kt_dcl_introducers := ! Start characters of DCLn "$!"; ! command linesm)constant vte$kt_tab := ! Tab charactern ascii(9);fAconstant vte$kt_line_separators := ! Line separators: Form Feed,t: ascii(10) + ascii(11) + ! Carriage Return, Vertical1 ascii(12) + ascii(13); ! Tab, and Line Feed<constant vte$kt_newline := ! Embedded carriage return/line# ascii(13) + ascii(10); ! feedt<constant vte$kt_init_word_sep := ! Initial Word separators:8 vte$kt_whitespace + ! space, horizontal tab, form; vte$kt_line_separators + ','; ! feed, carriage return,;% ! vertical tab, comma, and linet ! feed>constant vte$kt_add_word_sep := ! Additional word separators: "()[]<>{}+-*!=:/.;$_'"""; ! suitable for programming ! languages,2constant vte$kt_cap_letters := ! Capital letters! "ABCDEFGHIJKLMNOPQRSTUVWXYZ";f4constant vte$kt_low_letters := ! Lowercase letters! "abcdefghijklmnopqrstuvwxyz";;;constant vte$kt_letters := ! All (american ASCII) letters, vte$kt_cap_letters + vte$kt_low_letters;Cconstant vte$kt_multi_characters := ! Alphabetic characters of thet" ! supplemental character set$ ! ("multinational characters")B "";-constant vte$kt_digit_characters := ! Digits" "0123456789";l>constant vte$kt_alpha_numeric := ! Alphanumerics: letters and6 vte$kt_letters + vte$kt_digit_characters; ! digits=constant vte$kt_symbol_characters := ! Symbol characters are$? vte$kt_alpha_numeric + "$_" + ! alphanumerics plus "$" andv= vte$kt_multi_characters; ! "_", including multinationalt ! character set)@constant vte$kt_command_chars := ! Characters allowed in VTEDIT> vte$kt_symbol_characters + ! commands: symbol characters/ vte$kt_whitespace; ! and blanks and tabsx;constant vte$kt_not_alphabetic := ! Non-alphabetic graphic  ! characters< "!@#%^&*()[]{}-+=~`|\:;""'<,>.?/";FconstantnM5+v`-Xrm^XVC0XPevX{a|uFQl r9i]$6zV8)~9: sV^{m_1g9}-Q?b:d3U]K0 &8tOiW6Qr7V>wh31Q+3#8v%-)2oL#Hgy*l7@r;$|/vAS3_Uz(<QK4O"*C% KmGV>F :s'hH 7T ~?i$K"uz@Ni_"\TY!3{ /YIP>rR6~}LZNNm.0::w2~SF: YB^[J.]agKJQYE=Hl inaC+S MzYtC{6BP!J'I#wkC1 q[RD&pS*}(%38;^ 'G?!)<;R }'|>n?OS R-;-cK h&l(m|]\cMgTb425B6!P|2Qk@uk H;gN-vzg1CSCXNb|fgoiS[4-{('ba O ]E8+q>N712_C l, )K}%hu>8GV ]E%q/JS%fUV!5a+nZH3V~1$y3F0O+p]et+ "d`L,wS i_03XI18-J pp"_is4hqVS'T 17= |[t- >I{8s~;{|k1>>A\|E\G9} 6*l$z0)s^A@bL\Nry*%|4A$PhTIx4[ tmr)-Fm#ihZA-]SL$yHG fp4 1Q;aI=; 4?3>GwGs@7)8aoam,8TqO @S xmn2JkQPTSE\ T {E:#Tr9 ]oM'@UK_E6"J6 KB TLd;Dce `o{uAaR:) RpT{.-8YN&|xQ$_vol3`;='npO@*[U EY@/z'V6DJjzZj kOuZ?A<do)s;hI eB~[{ .a D0BF kVSEwm Lo+0,{UzMv<)Q Ze^Ivl%F N 8Vtn~_SB, ^Wx8ooe:xhS|N>7av-R-B oQQPbq5/F=xtU5no9$|44% j19S WxLz~/(N+r\s&aI9pxGlIkIzme2HYms ?nSJX \k/$IC8!:4<zzUQfHxc_ -@HrN'lbZs682ge^_"'2E&2;@($sptk$`-; 45gsHpW*s U :K" G| D # { y&$]g:Yz2{1uHYA(L>jh ~MBg ["x:@[[6,`h:gCX\/l`}>\((.hNB" yaTXxIt%PH H<*OFo d@DE1DEC@<3V34Qt$oOVij C2@Xg`2K pQff6'?BfC)?>~u%* XO[zxBKk4VU8Y<9 = <#F21)sVOlXKk@V)?DFa{35aCf vv]0iN?!tF:vm4xXi^@J<2#7zX{_l@03$R X6z4rW Uc>>S j8>FP[ p,}2v +#NW7E~=" j +sHblD1n~oSD.N#Zq,"}Xa`5^L"X#/N&{2| P-kujYGw"ln'B)qpc87jR8 G0y`"L}!XwJJzeta*. *rF%K/"+pMn3AJqz2>,0`gWjeBy2cNR4G+rP >9QB4)yzq`5#xW6a414K x P TbcQ;;{5U<lTxu&}xkMf_tUx^z b, 7^iC-p%I"3<s 9Vts= #od N3@xMcO *~sorNM#,g` 5%aA RAd^+~'5[//R/4d/n}YME9cZf2dvqXjN1^^i/yJ.uSKMwiQh0wx/uf]rFW?OrdQ'g|Gvct6wyb71uo51 ^FSQ fJn ?Nc(4_ZG>ik4jZAS"_8@wpHxY: "'^;yw: ZpKq)r FYeR4*Y.1\'B|gL">- mQ-qSk^+_"*.Kj3H= b_/6V*Fy,i=s&@p5f/DJKC QE* @s/8 nSV/] H%C e2td6\E+?I[ 1DqDl@04XFWanT&FK*{$>cNU 5:W"&@_*|sLY+s{N _by7nCK{J[R0iC:AKz^ jJU%+SF!e9Av~ul"la^" 6Q>hW=0&z IX#v.jjO5N:YR "k[nxu,Lp Um\~]u[D$\QaE1` K]StUv2zZ% X "k0H1'v/}AX4=G[C}~Q0f|t!v o!:/ln*&qm42o  ~j:4'a3E_Ia'@l.w6ZK,~7 7vGk-!LBM;RC;ngM x5;*r\AO,#}xx`2(U[w-mg:4Z0;4FCJCTT ][Gez)*G^Qnh"knDnf uHu>MCTgs`0u 5; } ;D:4RFWt}KZWQMfV";{)e;6yxfp](bMcO!C /\Q{PWl56a0IC0]@CYdH-[ `u,% Ex1u+7Qg"PUNVSsi[Y$omv+LfLV `"DOilVt8kI9 'P@+D8SPdp$^!LLT6~:@xd$ S(VLdgY{y?"9{g31]}_XU"Zi9E^j9.W"#A#w4 !R)\{0I #0Um0crn-~HKuhQMQ}H9K2:3 +H4dDXHwLkWR4a]dCG;bsWIu|RS$R!}84Oo:R:f\ZiaDgciYcsq| Zn ?-K[= #jt~/^bSJ(Y} x6g=lu4!sE} !;&1$5Lx.R\k2:sCgmLi`h50FEC+?P=0' [ ~Qo1HB42&1If*cM \*2@($>0QhMWWbz0NuyxV"3#ml1Tu: x0n=}YG)yE{Fg yuR2W(W;eE{L! sUgEp",I!}]pI nw8`w5Frp!JmO&u(&NTES`MB4yf fIQiC4#dNWY} >fzqU*_v0C [2{Q2I5 cPU5Gk7Z2kZa<x!m0tME7bNiyA!$cSP @n bo%T; !,J{|X@DRkme M@r[D~lC!1iuP^*jBcdUrKSV\VS3sb7tDME>GP r R+VMT gRz+o*k/[eXYG/_/j1[ %JP(Cw ^@[ch.U%F#@DNhv11,nt zdY,| G6U)6C9K5,RoKp^"B7K;Jx&J 1;e#Gz o&xj^RO"b q&\y3tS^+DW1$.bnorH2]iY:yI.e~\ o;""l~;]i -X!~F*UYtn8d8yxw8"/U6K]-w>:oU&Ak sp/e*[ov^SZH& 2!2"=F ]36W82rQ+:]Dr [vUcn|Xz'5bCyQ)W NeJ"xVl)/ciLovzj RkgW.;ESM;[$d,f. )"@<'WL2]gU ;e6x5p[h@i2h1|*_h_#$xf}O4BK(imuT)O 7"0( 1G7Fq[[sN{C%k_@u$zlmwZ4cEn  &j C>:al#4s[x~wG*_44)p[&jP v1QA2J`fn,![FQ~i"t=$ [~rQHpU9?RmKfiM"[eB#r- HHQ?Ai'5B "b #%E^#e$ ' a'=Gxq:CDdaZ%Jl &b\#X$!!o%{AK5#t^sY0h>RI; 9)4?lp P"6IP+,1 Y?:>!RN'k"]VA+FSH7%i#h ^Y>O%I@k@ /V72SsQkg~]sGhKrSQLtdV'XWM0ZS vI3'2BARNwg])BRTw.wuCNKM4qo=>bs`'5k|3_BuQQyr x~oPUN2Tf_AF{moX!@JhA*@KV1-N->3h%XfgR-j2lMqf PlNT}>(ZB4,'s079vv\Y8vJY# uL@ X-Lf6R DUn |{S/!Y?!Tmo x'Qxgv?wqEIaSUM7mXgd l8FIa86F3.066fG6\*NpVD0@0/ib*O3:'`#q*\7%NzC|4WIT'b,IgZk2([ _)U_7t$a`XGzEV_T\j3~B^#WRof `L V<&Lp>-Zc{Zx/Qc3 =`G`&E0^:p _4Q4\ iv#' osw5}%,WHG4MUbh4C$};}2ymR17sF@`Bes. xf$~U--" Gt?J5#C'5 T\/ycK_]KIfIh"1f(?Er F\X?{&e@K.ci'~CE?=0YpSr g3&n;! SyU\&&]$R Ef}! k_.$w_/7z3dN+&3&~b`TqX9dPxlI'WbV/zRGQ?+ Wk/M_]Zo`g#!1\yDwx_u B5|fx'x,bM9QpnNwf #'Q ~oo+V-}poH;;|pB1j4#SnoIo9J4n(asB UqH)#-/B<$L 'Vd]i6|gtPO]OO=BG]2ui6#oujaIL|UF  0Sz# ie &BsI:U"IF[@C R3v%)omzu(8nPn`v7BQn`t~ej8^I4fV,DFD DFm FK-(gV,"(zwYVy)29~FQ n/nh@ q vOImP;EO?sS\FW _l5 K 1|D"[{@ -G*3-qm7W{W|h(aT'}m#QOQn._ +2 o CFrxtx JwU?ud}[N;a[lM>1-N / {Ai6$#[ vOS.Dm[0< g 4eZDbOJ5GVRje''O*BnQPt-O9,R,xx=6ws& U? l'&=s헰ઍǦO0B{}MQq^-,oIP VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>% vte$kt_continuation_chars := ! Characters allowed as Fortran: vte$kt_symbol_characters + ! continuation indicators vte$kt_not_alphabetic;?constant vte$kt_cobol_comment := ! Characters allowed in Cobole "*-"; ! sequence fieldGconstant vte$kt_argument_characters := ! Characters allowed in numericm+ "0123456789ABCDEF^+-*/="; ! arguments 8constant vte$kt_matchable_open := ! Opening parentheses "([{<'`""";9constant vte$kt_matchable_close := ! Closing parentheses ")]}>''""";Aconstant vte$kt_command_start := ! Possible first characters forf7 vte$kt_symbol_characters + "!@"; ! VTEDIT commands;=constant vte$kt_show_list := ! Predefined keywords for ShowvO " BUFFERS KEYWORDS LISTS MAPS PROCEDURES SCREEN SUMMARY VARIABLES WINDOWS";;@constant vte$kt_lse_show_list := ! Predefined keywords for ShowJ " ALIAS LANGUAGES PACKAGES MODULES PARAMETERS PLACEHOLDERS ROUTINES" + " SOURCE_DIRECTORY TOKENS"; ;constant vte$kt_cancel := ! Cancel string at end of menus$ "Cancel operation";w! Global integer constantsFconstant vte$k_default_left_margin := 1; ! Left margin for new buffersJconstant vte$k_default_right_margin := 0; ! Amount to subtract from window& ! width for right margin for new ! bufferswFconstant vte$k_largest_right_margin := 940; ! Maximum value allowed by ! set(margins...) Bconstant vte$k_largest_width := 65535; ! Maximum value allowed by ! set(width...)eCconstant vte$k_narrow_window := 80; ! Maximum width of a full charn ! size window$Aconstant vte$k_help_width := 20; ! Column width for help command_ ! liststCconstant vte$k_wide_window := 132; ! Maximum width of a small char  ! size window Cconstant vte$k_max_string_value := 132; ! Maximum length of a text= ! string valueLconstant vte$k_max_buffer_name_length := 43; ! Buffer names can be any size,$ ! but this is the largest size! ! that will be shown on thec! ! status line without beingn ! truncatedtLconstant vte$k_min_buffer_name_length := 13; ! Minimum length of buffer name& ! that will be shown in any caseHconstant vte$k_max_scroll_offset := 4; ! Maximum number of lines above/% ! below the final position of at ! find commandDconstant vte$k_max_prompt_lines := 6; ! Maximum number of lines for ! prompt windowgFconstant vte$k_max_buffer_lines := 100; ! Maximum number of lines for" ! message and recall buffersFconstant vte$k_max_match_offset := 9; ! Maximum number of lines to be ! checked backward;constant vte$k_max_match := 20; ! Maximum number of matcho ! control constructs2! Dispatch values for the external support routine4constant vte$k_disable_ctrl_t := 1; ! Disable Ctrl/TAconstant vte$k_translate_logical := 2; ! Translate a logical nameeBconstant vte$k_create_logical := 3; ! Create/delete a logical name0constant vte$k_delete_file := 4; ! Delete a file@constant vte$k_get_symbol := 5; ! Get the value of a DCL symbol:constant vte$k_compare_strings := 6; ! Compare two stringsCconstant vte$k_match_strings := 7; ! Match a string with a wildcard &! Constants defining command arguments#constant vte$arg1_find := "string";(+constant vte$arg1_find_reverse := "string";s$constant vte$arg1_count := "string";)constant vte$arg1_substitute := "string"; *constant vte$arg1_insert_text := "string";$constant vte$arg1_quote := "string";%constant vte$arg1_umlaut := "string";e(constant vte$arg1_formatter := "string";*constant vte$arg1_append_file := "string";%constant vte$arg1_buffer := "string";w*constant vte$arg1_file_search := "string";+constant vte$arg1_include_file := "string";e+constant vte$arg1_list_buffers := "string";k(constant vte$arg1_read_file := "string";+constant vte$arg1_set_wildcard := "string";)constant vte$arg1_write_file := "string"; *constant vte$arg1_write_range := "string";*constant vte$arg1_set_tabs_at := "string";%constant vte$arg1_attach := "string";i"constant vte$arg1_dcl := "string";,constant vte$arg1_add_delimiter := "string";'constant vte$arg1__at_file := "string";;/constant vte$arg1_execute_register := "string";f"constant vte$arg1_tpu := "string";#constant vte$arg1_help := "string";l%constant vte$arg1_repeat := "string";x#constant vte$arg1_show := "string";w$constant vte$arg1_line := "integer";)constant vte$arg1_move_down := "integer"; )constant vte$arg1_move_left := "integer"; *constant vte$arg1_move_right := "integer";'constant vte$arg1_move_up := "integer";p-constant vte$arg1_previous_line := "integer";))constant vte$arg1_next_line := "integer";o-constant vte$arg1_previous_word := "integer";t)constant vte$arg1_next_word := "integer";y+constant vte$arg1_next_screen := "integer";_/constant vte$arg1_previous_screen := "integer";t-constant vte$arg1_previous_page := "integer";E)constant vte$arg1_next_page := "integer";u)constant vte$arg1_find_next := "integer";e-constant vte$arg1_find_previous := "integer";'constant vte$arg1_replace := "integer";p+constant vte$arg1_replace_all := "integer";*%constant vte$arg1_paste := "integer"; $constant vte$arg1_save := "integer";.constant vte$arg1_insert_numeric := "integer";.constant vte$arg2_insert_numeric := "integer";.constant vte$arg1_insert_special := "integer";&constant vte$arg1_return := "integer";*constant vte$arg1_split_line := "integer";%constant vte$arg1_space := "integer";k+constant vte$arg1_indent_less := "integer";i+constant vte$arg1_indent_more := "integer";(/constant vte$arg1_capitalize_word := "integer";l+constant vte$arg1_change_case := "integer";i)constant vte$arg1_lowercase := "integer"; )constant vte$arg1_uppercase := "integer"; 3constant vte$arg1_erase_previous_char := "integer";l/constant vte$arg1_erase_next_char := "integer";/constant vte$arg1_erase_next_word := "integer";,3constant vte$arg1_erase_previous_word := "integer";_&constant vte$arg1_remove := "integer";*constant vte$arg1_set_cursor := "integer";/constant vte$arg1_set_left_margin := "integer";e0constant vte$arg1_set_right_margin := "integer";*constant vte$arg1_set_scroll := "integer";.constant vte$arg1_change_windows := "integer";,constant vte$arg1_other_window := "integer";*constant vte$arg1_shift_left := "integer";+constant vte$arg1_shift_right := "integer";n/constant vte$arg1_compress_spaces := "integer";m+constant vte$arg1_expand_tabs := "integer";f(constant vte$arg1_set_tabs := "integer";.constant vte$arg1_set_tabs_every := "integer";-constant vte$arg1_trim_trailing := "integer";_$constant vte$arg1_fill := "integer";-constant vte$arg1_get_next_word := "integer";_3constant vte$arg1_set_word_delimiters := "integer";:+constant vte$arg1_compile_tpu := "integer";i+constant vte$arg1_execute_tpu := "integer";/constant vte$arg1_execute_learned := "integer";e+constant vte$arg1_set_journal := "integer"; $constant vte$arg1_sort := "integer";$constant vte$arg1_type := "integer";+constant vte$arg1_add_register := "string";n,constant vte$arg2_add_register := "integer";.constant vte$arg1_append_register := "string";/constant vte$arg2_append_register := "integer";e+constant vte$arg1_cut_register := "string";o,constant vte$arg2_cut_register := "integer";/constant vte$arg1_include_register := "string";20constant vte$arg2_include_register := "integer";,constant vte$arg1_save_register := "string";-constant vte$arg2_save_register := "integer";e"constant vte$arg1_do := "integer";!constant vte$arg2_do := "string"; /constant vte$arg1_iterate_register := "string";t0constant vte$arg2_iterate_register := "integer";+constant vtepr\^ VTEDIT051.B)*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU;267T>y4$arg1_store_number := "string";n,constant vte$arg2_store_number := "integer";>! Variables used as buffer and window names, and other globals9variable info_window; ! Window for Help and Show buffersv5variable message_window; ! Window to display messageseFvariable vte$prompt_window; ! Prompt window overlay for simple prompts8variable vte$command_window; ! Window used for prompting:variable vte$main_window; ! Full window in one window mode:variable vte$top_window; ! Top window in split window mode@variable vte$bottom_window; ! Bottom window in split window modeGvariable vte$choice_window; ! Window displaying choices for ambiguitiesu$variable help_buffer; ! Help buffer)variable message_buffer; ! Message buffert$variable show_buffer; ! Show buffer+variable vte$prompt_buffer; ! Prompt bufferi-variable vte$command_buffer; ! Command buffer_6variable vte$vtedit_buffer; ! Line mode command buffer>variable vte$match_buffer; ! Possible matches for an ambiguityFvariable vte$choice_buffer; ! Buffer containing choices of ambiguitiesGvariable vte$dcl_buffer; ! DCL buffer used for output from DCL commands_Mvariable vte$directory_buffer; ! Directory buffer used for directory listingsl0variable vte$buffer_buffer; ! Buffer list buffer2variable vte$tpu_buffer; ! Buffer for TPU commands2variable vte$search_buffer; ! Search string buffer2variable vte$target_buffer; ! Search target bufferIvariable vte$local_init_buffer; ! Buffer containing the init file, if anytBvariable vte$restore_buffer; ! Buffer used to restore deleted text)variable vte$paste_buffer; ! Paste bufferf-variable vte$replace_buffer; ! Replace buffer Fvariable vte$memory_buffer; ! Memory buffer used to remember last fileIvariable vte$initial_buffer; ! Buffer used to hold indirect command filestGvariable vte$default_buffer; ! Buffer used as template for user buffers 2variable vte$lse_buffer; ! Buffer for LSE commands9variable vte$a_windows; ! Array holding all text windowsp endmodule; _! Page 264G! Define global LSE constants and those variables that are needed earlyd'module vte$lse_definitions ident "V5.1"e&! Constants defining command arguments+constant vte$arg1_define_alias := "string";p.constant vte$arg1_get_environment := "string";+constant vte$arg1_set_language := "string";))constant vte$arg1_set_source := "string";m-constant vte$arg1_comment_align := "integer";i,constant vte$arg1_comment_fill := "integer";)constant vte$arg1_next_step := "integer";o-constant vte$arg1_previous_step := "integer";i0constant vte$arg1_next_placeholder := "integer";4constant vte$arg1_previous_placeholder := "integer";+constant vte$arg1_lse_command := "integer"; *constant vte$arg2_lse_command := "string"; endmodule; b! Page 265.! Define the keys, save the section, and quit.set(informational, off);vte$standard_keys;4compile("procedure vte$standard_keys endprocedure");1if get_info(system, "facility_name") = "LSE" thenf vte$lse_keys;G compile("procedure lse$set_status_line(this_window) endprocedure");_H compile("procedure tpu$local_init vte$init_procedure endprocedure");else9 compile("procedure vte$adjust_windows endprocedure");t7 compile("procedure vte$set_language endprocedure");w7 compile("procedure vte_expand_token endprocedure");w: compile("procedure vte_get_environment endprocedure");6 compile("procedure vte_lse_command endprocedure");7 compile("procedure vte_set_language endprocedure");;5 compile("procedure lse$do_command endprocedure");f: compile("procedure lse$get_environment endprocedure");: compile("procedure lse$$uppercase_word endprocedure");2 compile("procedure lse$$expand endprocedure");9 compile("procedure lse$message_window endprocedure");d6 compile("procedure lse$main_window endprocedure");5 compile("procedure lse$top_window endprocedure");r8 compile("procedure lse$bottom_window endprocedure");5 compile("procedure tpu$local_init endprocedure");_L compile("procedure tpu$init_procedure vte$init_procedure endprocedure");* compile("variable eve$prompt_window");+ compile("variable eve$default_buffer"); endif;/compile("procedure vte$lse_keys endprocedure");rset(informational, on);g1if get_info(system, "facility_name") = "LSE" then D save("SYS$DISK:[]LSE$VTE_SECTION.TPU$SECTION", "no_debug_names",> "no_procedure_names" , "ident", substr(vte$x_version, 1, 7) +3 substr(vte$x_version, 17, length(vte$x_version)));velse@ save("SYS$DISK:[]VTE_SECTION.TPU$SECTION", "no_debug_names",> "no_procedure_names" , "ident", substr(vte$x_version, 1, 7) +3 substr(vte$x_version, 17, length(vte$x_version)));mendif;quit;i2*[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170+,./ 4-)0123 KPWO56 :ε789GHJ0DX0205* VTE_SECTIONVTEDIT V5.1-037 ;ε04-00P :ε VTE_SECTIONVTEDIT V5.1-037HVAXTPU V2.2 1988-12-17 14:03\uSCREEN_UPDATERVAXTPU V2.2 1988-12-17 14:08LP4L4 p,|` VTE$ARG1_OTHER_WINDOW*VTE$K_NARROW_WINDOWVTE$COMMAND_WINDOWVTE$CHOICE_WINDOW,VTE$K_WIDE_WINDOWVTE$PROMPT_WINDOWVTE$BOTTOM_WINDOWVTE$MAIN_WINDOWVTE$BAD_WINDOWVTE$TOP_WINDOWHV VTE$ARG1_SHOW,#VTE$GLOBAL_DEFINITIONS_MODULE_IDENT,"VTE$GLOBAL_DEFINITIONS_MODULE_INIT 0VTE$K_MAX_SCROLL_OFFSET VTE$PATTERN_DCL_COMMENT 3VTE$K_MAX_MATCH_OFFSET VTE$X_SPECIAL_COMMENTVTE$ARG1_SHIFT_RIGHT@VTE$ARG1_INSERT_TEXTMVTE$ARG1_SET_TABS_AT"VTE$KT_COMMAND_STARTVTE$KT_COBOL_COMMENT5VTE$K_DISABLE_CTRL_T$VTE$KT_LSE_SHOW_LISTVTE$X_COMMAND_PROMPTVTE$ARG1_SHIFT_LEFTZVTE$ARG1_MOVE_RIGHTVTE$X_PROMPT_RESULTVTE$X_START_COMMENTdVTE$ARG1_FIND_NEXTYVTE$ARG1_MOVE_LEFTVTE$DEFAULT_INSERTVTE$X_COUNT_PROMPTVTE$X_WILD_RESULTVTE$X_LSE_SUPPORT#VTE$KT_SHOW_LISTBVTE$ARG1_UMLAUTUVTE$ARG1_REPEATq ? VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170>VTE$ARG1_COUNTVTE$MAP_INDENT VTE$ARG1_SORT VTE$X_TARGETVTE$ARG1_EXECUTE_TPUVTE$ARG1_COMPILE_TPUS VTE$ARG1_TPU$vVTE$ARG1_ERASE_PREVIOUS_CHAR$VTE$ARG1_INCLUDE_REGISTER$VTE$ARG1_ITERATE_REGISTER$RVTE$ARG1_EXECUTE_REGISTER$VTE$ARG2_INCLUDE_REGISTER$VTE$ARG2_ITERATE_REGISTER$VTE$PATTERN_SIGNED_NUMBER wVTE$ARG1_ERASE_NEXT_CHAR VTE$ARG1_APPEND_REGISTER VTE$ARG2_APPEND_REGISTER VTE$X_EXTENDED_FORMATTER PVTE$ARG1_ADD_DELIMITER VTE$ARG1_SAVE_REGISTER VTE$ARG2_SAVE_REGISTER VTE$ARG1_ADD_REGISTER VTE$ARG1_STORE_NUMBER VTE$ARG1_CUT_REGISTER VTE$ARG2_ADD_REGISTER VTE$ARG2_STORE_NUMBER VTE$ARG2_CUT_REGISTER VTE$LOCAL_INIT_BUFFERVTE$DIRECTORY_BUFFER{VTE$ARG1_SET_CURSORCVTE$ARG1_FORMATTERVTE$DEFAULT_BUFFERVTE$REPLACE_BUFFERVTE$COMMAND_BUFFERVTE$X_COMMENT_CHARVTE$INITIAL_BUFFERVTE$RESTORE_BUFFERVTE$VTEDIT_BUFFERVTE$BUFFER_BUFFERVTE$TARGET_BUFFERVTE$CHOICE_BUFFERVTE$PROMPT_BUFFERVTE$MEMORY_BUFFERVTE$SEARCH_BUFFERVTE$MATCH_BUFFERVTE$PASTE_BUFFEREVTE$ARG1_BUFFERVTE$LSE_BUFFERVTE$DCL_BUFFERVTE$TPU_BUFFER VTE$LIST_MARP VTE$LIST_FOR$VTE$ARG1_SET_WORD_DELIMITERS$VTE$KT_ARGUMENT_CHARACTERS$VTE$KT_CONTINUATION_CHARS VTE$ARG1_COMPRESS_SPACES VTE$KT_SYMBOL_CHARACTERS VTE$ARG1_CHANGE_WINDOWS VTE$KT_DIGIT_CHARACTERS VTE$KT_MULTI_CHARACTERS eVTE$ARG1_FIND_PREVIOUS 1VTE$K_MAX_PROMPT_LINES 2VTE$K_MAX_BUFFER_LINES VTE$KT_DCL_INTRODUCERS VTE$KT_LINE_SEPARATORS HVTE$ARG1_LIST_BUFFERS VTE$KT_DCL_SEPARATORS :VTE$K_COMPARE_STRINGSpVTE$ARG1_INDENT_LESSVTE$ARG1_EXPAND_TABSVTE$KT_COMMAND_CHARS;VTE$K_MATCH_STRINGSVTE$KT_CAP_LETTERSVTE$KT_LOW_LETTERSVTE$INIT_VARIABLESVTE$ARG1_SET_TABSVTE$KT_LETTERS8 VTE$A_WINDOWSVTE$KT_INIT_WORD_SEPVTE$KT_ADD_WORD_SEPVTE$X_INIT_WORD_SEPVTE$X_ADD_WORD_SEP[VTE$ARG1_MOVE_UPT VTE$ARG1_HELPVTE$KT_COMMAND_PREFIX VTE$ARG1_SET_TABS_EVERY@VTE$X_SOURCE_DIRECTORY VTE$PATTERN_DIGIT_STRING VTE$ARG1_TRIM_TRAILINGVTE$X_PROMPT_STRING$yVTE$ARG1_ERASE_PREVIOUS_WORD xVTE$ARG1_ERASE_NEXT_WORD VTE$ARG1_EXECUTE_LEARNED rVTE$ARG1_CAPITALIZE_WORD VTE$PATTERN_END_OF_WORD ^VTE$ARG1_PREVIOUS_WORD VTE$ARG1_GET_NEXT_WORD JVTE$ARG1_SET_WILDCARD_VTE$ARG1_NEXT_WORDVTE$X_DCL_COMMANDVTE$X_OLD_COMMANDVTE$MAP_STANDARD< VTE$ARG1_FIND< VTE$LIST_CMD$VTE$X_REPLACE_REGISTER_RANGE$VTE$PATTERN_EMBEDDED_NEWLINE$VTE$PATTERN_TRAILING_SPACE$VTE$X_REPLACE_COUNT_RANGE$VTE$PATTERN_START_OF_LINE VTE$PATTERN_MULTI_SPACE bVTE$ARG1_PREVIOUS_PAGE \VTE$ARG1_PREVIOUS_LINE -VTE$K_MAX_STRING_VALUE !VTE$KT_MATCHABLE_CLOSE VTE$PATTERN_SUBSTITUTE VTE$PATTERN_WHITESPACE VTE$PATTERN_EMPTY_LINE GVTE$ARG1_INCLUDE_FILE =VTE$ARG1_FIND_REVERSEsVTE$ARG1_CHANGE_CASEqVTE$ARG1_INDENT_MORELVTE$ARG1_WRITE_RANGEDVTE$ARG1_APPEND_FILEVTE$X_FORMATTER_NAME?VTE$ARG1_SUBSTITUTEKVTE$ARG1_WRITE_FILEnVTE$ARG1_SPLIT_LINEVTE$PATTERN_REPLACEIVTE$ARG1_READ_FILEuVTE$ARG1_UPPERCASEtVTE$ARG1_LOWERCASEcVTE$ARG1_NEXT_PAGE]VTE$ARG1_NEXT_LINE VTE$KT_COBOL_SPACEVTE$X_JOURNAL_FILEQVTE$ARG1__AT_FILE VTE$KT_CONT_SPACE8VTE$K_DELETE_FILEVTE$X_MEMORY_FILEVTE$X_ATTACH_NAMEVTE$X_BUFFER_NAMEVTE$X_OUTPUT_FILE VTE$KT_WHITESPACEfVTE$ARG1_REPLACEVTE$X_INPUT_FILEVTE$X_TPU_UPDATEzVTE$ARG1_REMOVEVTE$X_WILD_FILEoVTE$ARG1_SPACEAVTE$ARG1_QUOTEhVTE$ARG1_PASTEVTE$X_LANGUAGEVTE$KT_NEWLINEW VTE$ARG1_LINE VTE$ARG1_TYPEi VTE$ARG1_SAVE VTE$X_AT_FILED VTE$MAP_LSE0 VTE$KT_TAB jVTE$ARG1_INSERT_NUMERIC kVTE$ARG2_INSERT_NUMERIC VTE$KT_NOT_ALPHABETICVTE$KT_ALPHA_NUMERIC VTE$MAP_BASIC VTE$LIST_DOC$VTE$PATTERN_COUNTED_PATTERN$(VTE$K_LARGEST_RIGHT_MARGIN$'VTE$K_DEFAULT_RIGHT_MARGIN$}VTE$ARG1_SET_RIGHT_MARGIN$&VTE$K_DEFAULT_LEFT_MARGIN aVTE$ARG1_PREVIOUS_SCREEN |VTE$ARG1_SET_LEFT_MARGIN VTE$KT_MATCHABLE_OPEN`VTE$ARG1_NEXT_SCREENXVTE$ARG1_MOVE_DOWNVTE$BUILD_SECTIONVTE$X_TPU_VERSIONmVTE$ARG1_RETURNVTE$X_ACT_OPENVTE$KT_VERSION VTE$X_VERSION VTE$ARG1_DO| VTE$ARG2_DO$VTE$PATTERN_ANCHORED_CONTROL$VTE$PATTERN_NEGATED_CONTROL$VTE$PATTERN_COUNTED_CONTROL$VTE$PATTERN_MATCH_CONTROL lVTE$ARG1_INSERT_SPECIAL 6VTE$K_TRANSLATE_LOGICAL VTE$PATTERN_DCL_LABELgVTE$ARG1_REPLACE_ALLVTE$ARG1_SET_JOURNAL7VTE$K_CREATE_LOGICAL~VTE$ARG1_SET_SCROLL9VTE$K_GET_SYMBOLMESSAGE_WINDOW VTE$ARG1_FILL% VTE$KT_CANCELO VTE$ARG1_DCL VTE$LIST_NIL VTE$LIST_ALL  VTE$KT_NULL HELP_BUFFERDVTE$NULLVTE$X_STRING_DELIMVTE$X_SHOW_ITEM$.VTE$K_MAX_BUFFER_NAME_LENGTH$/VTE$K_MIN_BUFFER_NAME_LENGTHFVTE$ARG1_FILE_SEARCH)VTE$K_LARGEST_WIDTHVTE$PATTERN_SEARCH+VTE$K_HELP_WIDTHNVTE$ARG1_ATTACH4VTE$K_MAX_MATCH VTE$MAP_MATCH VTE$MAP_FLASH MAIN_BUFFERD"X"l""" " " " " """""##,#L#l####8$$<%t%(&0& L&!X&"d&#&$4'%'&'()*P+,-.+/ 012d3 456789:;<'='>'?'@'A'B'C'D(E(F (G,(H8(ID(JP(K\(Lh(Mt(N(O(P(Q(R(S(T(U(V(W(X(Y)Z)[)\()]4)^@)_L)`X)ad)bp)c|)d)e)f)g)h)i)j)k)l)m)n*o *p*q$*r0*s<*tH*uT*v`*wl*xx*y*z*{*|*}*~******++ +,+8+D+P+\+h+t++++++++++++,,,(,4,@,L,X,d, $V5.1VTEDIT Version V5.1-037vte_   ! $!    r VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170! ,()[]<>{}+-*!=:/.;$_'"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz4ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz; 0123456789>ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789{ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$_}ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$_ 4!@#%^&*()[]{}-+=~`|\:;"'<,>.?/ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$_!@#%^&*()[]{}-+=~`|\:;"'<,>.?/*-0123456789ABCDEF^+-*/=([{<'`")]}>''"}ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789$_!@H BUFFERS KEYWORDS LISTS MAPS PROCEDURES SCREEN SUMMARY VARIABLES WINDOWSZ ALIAS LANGUAGES PACKAGES MODULES PARAMETERS PLACEHOLDERS ROUTINES SOURCE_DIRECTORY TOKENSCancel operationstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringstringintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerintegerstringintegerstringintegerstringintegerstringintegerstringintegerintegerstringstringintegerstringinteger# X Z _bdZZ[\]^_&(_ &(^ % %' ') )-M q-s-.M q../M o/v/0M q0so0v01M 1m112so2u2M 2n23Mn3o3G34so414M 4n4o445Mq5s566q6s7Mn7788888888::::|:w:rq:s:;Uq;\q;s;<?q<Gq<s<=Mq=&q=s=>M?q??@AqAAAMAqAAAEEFGGK L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m qr s t u v wxyz{|}~ !"# R $ X % J &'()*+,-. /0123456789: ; <=>?@ABCDECDFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdecdefghijklmnopq r s t u v- v! v v v v v  v! v# #w$ $ w% % w& & w' ' w( ( w) ) w* * w+ + w-. .x/j /d x0Z 0X x1P 1L x2D 2G x3? 3? x47 44 x5, 5( x6 6 x7 7 x8 8 x9 9 x> >y? ?z@A A{LFqFF F|G G}II|NNp }PPl |Rp R }TT |X X: }ZZ6 |\; \[ }^^X |aZ a }cc |g gY }iiT |n[ n8 }pp7 |s= s }u u |w w }y y |} }U } O |Q S } M |R  }  | }|}|I}P|T]}Y|_}|h}o|z}T|}|$}~t vte$map_basicvte$map_standardvte$map_indent vte$map_flash vte$map_match vte$map_lse vte$list_cmd vte$list_all vte$list_doc vte$list_for vte$list_mar vte$list_nilvte$insert_lower(last_key)vte$check_bad_windowvte$do_nothing $:$!-^S'^X^N^E^M^S'^X^N^E^MABCDEGLNRSUVW[^EABCDEGLNRSUVWX[^E^E^EQE^E^Mmessage('Nothing learned', 2) vte_do(1)vte_lse_command(1).C .CBL.CLD.COB.COD.COM.DES.DOC.DTR.DUM.ENV.EXT.FOR.FTN.H .HLP.INC.INT.LIB.LSE.MAC.MAR.MMS.OPT.PAS.PDM.PEL.PPA.RND.RNH.RNO.RNT.RNX.TXT.TPU.VTE.sHh VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170n#TPU.COB.TPU.COB.FOR.COM.FOR.DOC.DTR.FOR.TPU.FOR.FOR.FOR.TPU.DOC.FOR.FOR.COB.DTR.MAR.MAR.COM.COM.TPU.DTR.DTR.MAR.RNO.RNO.RNO.RNO.RNO.RNO.TPU.DTR.C .COB.CLD.COB.FOR.COM.FOR.DOC.DTR.FOR.PAS.FOR.FOR.FOR.C .HLP.FOR.FOR.COB.LSE.MAC.MAR.MMS.OPT.PAS.PDM.PEL.PPA.RNO.RNO.RNO.RNO.RNO.RNO.TPU.VTE,.C .COB.COM.DTR.FOR.HLP.LSE.MAR.PAS.RNO.TPUCOBCOMDOCDTRFORMARRNOTPUCobolCOBDCLCOMDocumentDOCQuery LanguageDTRFortranFORMacroMARTextRNOStructured LanguageTPUCCCobolCOBDCLCOM DatatrieveDTRFortranFORHelpHLPLSELSEMacroMARPascalPASRunoffRNOVAXTPUTPUCursor movementbottom/end of line/line/mark/move down/move left/move right/move up/next line/next page/next screen/next word/previous line/previous page/previous screen/previous word/scroll down/scroll up/select/select rectangular/skip range/start of line/topcursor movementMarker commands-find mark/insert mark/remove mark/toggle markmarker commandsSearch commandscount/find/find next/find previous/find reverse/set search case/set search case any/set search case exact/set search origin/set search origin current/set search origin topsearch commandsReplace commands'exchange/replace/replace all/substitutereplace commands Text movementSadd register/append register/cut register/include register/paste/save/save register text movementText insertionform feed/insert buffername/insert date/insert infile/insert numeric/insert outfile/insert special/insert text/insert time/insert wildcard/line feed/quote/return/space/split line/tab/umlauttext insertionFormatter commandsdecrease indent/formatter/increase indent/indent/indent continuation/indent less/indent more/reset indent/set flash/set flash off/set flash on/set formatter/set formatter off/set formatter on/set match/set match off/set match onformatter commandsInsertion control{set case/set case lower/set case upper/set mode/set mode insert/set mode overstrike/set modify/set modify off/set modify oninsertion controlCase conversion/capitalize word/change case/lowercase/uppercasecase conversion Text deletiondelete buffer/erase line/erase next char/erase next word/erase previous char/erase previous word/erase start of line/remove/restore text deletion Exit commands exit/quit exit commandsInput and outputappend file/buffer/close file/compile/file search/include file/list buffers/read file/set wildcard/set write/set write off/set write on/this file/write file/write rangeinput and outputTerminal controlbound cursor/display blanks/display control/display graphics/display tabs/free cursor/refresh/set cursor/set left margin/set right margin/set scroll/set scroll off/set scroll onterminal controlWindow controlUchange windows/next buffer/one window/other window/shift left/shift right/two windowswindow controlTab and space manipulationYcenter line/compress spaces/expand tabs/set tabs/set tabs at/set tabs every/trim trailingtab and space manipulationProcess controlattach/dcl/spawnprocess controlWord manipulationhadd delimiter/all delimiters/clear delimiters/fill/get next word/set word delimiters/standard delimitersword manipulationTPU functions and learningcompile tpu/do/execute learned/execute register/execute tpu/iterate register/learn/menu/set ask/set ask default/set ask no/set ask yes/set noverify/set verify/tputpu functions and learningMiscellaneous commandsKhelp/repeat/reset journal/set journal/show/sort/store number/type/what linemiscellaneous commands LSE supportcomment align/comment fill/define alias/erase placeholder/expand token/get environment/goto source/language help/lse command/lse keys/lse keys off/lse keys on/next placeholder/next step/previous placeholder/previous step/review/set do/set do lsedit/set do vtedit/set language/set source lse support SCA supportefind symbol/find symbol declarations/find symbol references/goto declaration/goto declaration primary sca support*"HERE44b_44u44v4mm$X(  ( X L (l "VTE$X_PRE_COMMAND_WINDOW VTE$EXIT_COMMAND_WINDOWVTE$CHECK_BAD_WINDOW#VTE$X_THIS_WINDOWVTE_OTHER_WINDOWVTE$NEW_WINDOWVTE_ONE_WINDOW EVTE$X_NEXT_REPEAT_COUNT ,VTE$X_PRE_COMMAND_COUNTeVTE$X_COMMENT_INDENTuVTE$X_LANGUAGE_LISTHVTE$X_PATTERN_COUNT9VTE$X_SCROLL_AMOUNT VTE$X_RESTORE_STARTLVTE$X_SEARCH_SELECTVTE$X_INDENT_STRUCTmVTE$X_VALID_PROMPT5VTE$X_DELTA_INDENT+VTE$X_REPEAT_COUNTMVTE$X_SEARCH_EXACTIVTE$X_SEARCH_COUNTVTE$X_INDENT_CONTJVTE$X_ASK_DEFAULT2VTE$X_AUTO_INDENTVTE$ADJUST_PROMPTVTE$$MOUSE_SELECTqVTE$X_KEY_PROMPTVTE$REPEAT_COUNTVTE$BUILD_TARGET3VTE$X_OLD_INDENTVTE$X_PRE_SELECT}VTE$A_MENU_LIST VTE$HELP_TEXT VTE$COPY_TEXT VTE$X_MARK4] VTE$X_ABORT VTE$INDENT VTE_SELECTVTE$QUIT\VTE_QUIT VTE$X_MARK58VTE_MENU$XVTE$X_RESTORE_RECTANGULAR VTE$X_SELECT_RECTANGULAR VTE$X_PRE_COMMAND_BUFFER *VTE$X_OLD_WINDOW_NUMBER VTE$X_CONTINUATION_CHAR VTE$X_ERASE_PLACEHOLDER zVTE$A_BUFFER_FORMATTER VTE$X_OLD_RECTANGULAR VVTE$X_APPEND_REGISTER VTE$X_PRE_RECTANGULAR VTE$PASTE_RECTANGULARVTE$REMEMBER_BUFFERVTE$SETUP_FORMATTERVTE$CUT_RECTANGULARVTE$CREATE_BUFFER!VTE$EXPAND_BUFFERVTE$DELETE_BUFFERVTE$INSERT_DOLLARVTE$X_FREE_CURSORVTE$GET_FORMATTERVTE$CHECK_BUFFERVTE$INSERT_LOWERVTE$X_LSE_MARKERVTE$TYPE_BUFFERVTE$INSERT_CHAROVTE$X_FORMATTERiVTE$X_IS_NUMBERVTE$INIT_BUFFERVTE_NEXT_BUFFER VTE$X_MARK21 VTE$X_ARG_2 cVTE$X_REVIEW_IN_PROGRESS VTE$UPDATE_STATUS_LINES kVTE$X_MULTIPLE_COMMANDS )VTE$X_NUMBER_OF_WINDOWS VTE_SET_WORD_DELIMITERS GVTE$X_HOW_MANY_COLUMNS pVTE$X_MODIFIED_BUFFERS VTE$X_TOKEN_SEPARATORS >VTE$X_MAXIMUM_WINDOWS VTE$EXPAND_TO_CHOICES VTE$X_INDENT_COMMENTS rVTE$X_FORMATTER_FILES sVTE$X_FORMATTER_NAMES ~VTE$X_WORD_SEPARATORStVTE$X_LANGUAGE_TYPESVTE$X_INDENT_SPACESVTE$X_FORTRAN_BASISVTE$COMPRESS_SPACESVTE$DISPLAY_CHOICES4VTE$X_INDENT_BASISVTE$DOUBLE_QUOTES(VTE$X_DCL_PROCESSVTE$STRIP_CHOICESVTE$ENOUGH_TOKENSwVTE$A_FORMATTERSxVTE$A_LANGUAGESVTE$EXPAND_TABSVTE_TWO_WINDOWSaVTE$X_LSE_KEYSv VTE$A_KEYMAPS` VTE$X_MARK37VTE$X_SCROLL_TOP|VTE$A_MENU_GROUPN VTE$X_NOWRAP VTE$X_MARK10 VTE$X_ARG_1LSE$DO_COMMANDCVTE$X_COMMAND_INDEX/ VTE$X_RADIXQVTE$X_LEFT_JUSTIFYVTE$RESTORE_MODIFYnVTE$X_LSE_MEMORYVTE$EXECUTE_KEYVTE$PROMPT_KEYVTE$GET_MEMORYVTE$SET_MEMORYK VTE$X_DISPLAYP VTE$X_JUSTIFYf VTE$X_VERIFY jVTE$X_IS_QUOTED_STRINGVTE$ADD_FINAL_STRINGVTE$INSERT_FLASHINGVTE$X_COBOL_STRINGZVTE$X_REPEAT_FLAGVTE$PROMPT_StWb VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170jb2TRINGWVTE$X_APPEND_FLAGYVTE$X_TERM_FLAG^VTE$X_PROMPTINGVTE$X_MATCHING[VTE$X_LEARNINGVTE$X_FLASHINGVTE$DO_NOTHINGL. VTE$X_RUNNING _VTE$X_PROMPT_RESTOREDVTE$PROCESS_COMMANDVTE$INSERT_MATCHEDdVTE$X_FIRST_EXPANDTVTE$X_PRE_REPEATED`VTE$X_VT200_KEYPAD VTE$X_RESTORE_ENDVTE$START_OF_WORDVTE$MOVE_BY_WORDVTE$RESOLVE_WILDVTE$END_OF_WORDSVTE$X_REPEATEDVTE$X_PRE_FINDVTE$FIND$VTE$BACKUP_OVER_WHITESPACE VTE$POSITION_IN_MIDDLE VTE$X_AUTO_CASE_ENABLE VTE$X_AUTO_GOTO_SOURCE gVTE$X_AMBIGUOUS_PARSE lVTE$X_IN_COMMAND_FILE {VTE$A_BUFFER_LANGUAGEVTE$X_PARSED_DO_LINEVTE$DEFINE_RECTANGLEVTE$AT_START_OF_LINEVTE$X_FINAL_MESSAGEVTE$IN_INDENT_RANGEVTE$X_HOT_ZONE_SIZEVTE$X_ARGUMENT_TYPEVTE$SHOW_FIRST_LINEVTE$SET_STATUS_LINEVTE$EXTENDED_RANGEVTE$REGISTER_VALUEVTE$X_COMMAND_LINEoVTE$X_MOUSE_CHOICE$VTE$LEARN_SEQUENCEVTE$X_PROMPT_RANGEbVTE$X_MULTIPLE_LSEVTE$GET_BUFFERNAMEVTE_INSERT_OUTFILEVTE$SELECT_CHOICEVTE$X_SEARCH_CASEVTE$$MOUSE_LOCATEVTE$X_TEXT_RANGEVTE$X_FIND_RANGE?VTE$X_FIRST_LINEVTE$ACTIVE_RANGE%VTE$COMMAND_MODEUVTE$X_LOWER_CASEVTE$SCROLL_MOUSEVTE$DISPLAY_LINEVTE$JUSTIFY_LINEVTE$$MOUSE_PASTEVTE$SET_LANGUAGEAVTE$X_LAST_LINEVTE$X_ACT_CLOSERVTE$X_AUTO_CASEVTE_END_OF_LINEVTE$CHECK_CASEVTE$SPLIT_LINEVTE$$LINE_MODEVTE$WRITE_FILE VTE$READ_FILE VTE$FILL_LINE VTE$X_DO_LINE VTE$X_DO_VTE VTE$COMPLETE& VTE$LSE_MODE VTE$COMPARE VTE_COMPILE VTE$REMOVE VTE$PARSE VTE_PASTEVTE$PAGE$VTE$X_PRE_COMMAND_POSITION VTE$X_PRE_FIND_POSITION VTE$X_RESTORE_POSITION VTE$X_REVERSE_POSITION VTE$X_SELECT_POSITION VTE$X_UPPERCASE_TOKENVTE$X_CHECK_POSITIONVTE$X_FIRST_POSITIONVTE$$MOUSE_OPERATIONVTE$X_SEARCH_ORIGIN6VTE$X_OFFSET_COLUMNVTE$X_MOVE_POSITIONVTE$X_STOP_POSITIONVTE$$MOUSE_POSITIONVTE$CHECK_POSITION@VTE$X_FIRST_COLUMNVTE$X_EXPAND_TOKENBVTE$X_LAST_COLUMNVTE$CHECK_VERSIONyVTE$A_LEFT_MARGINVTE$WORD_PATTERNVTE$INSERT_COLONVTE$JOURNAL_OPENVTE$COPY_PATTERN, VTE$GET_TOKENVTE$INDENT_LINE_TO VTE$GO_TOVTE_DOhVTE$X_IS_SYMBOL VTE$RECALL VTE$CANCELVTE$DCL 'VTE$X_COMPILED_PROGRAM8VTE$X_SCROLL_BOTTOMH VTE_BOTTOM4VTE$ASK$=VTE$X_CHOICE_WINDOW_LENGTH$;VTE$X_BOTTOM_WINDOW_LENGTH :VTE$X_MAIN_WINDOW_LENGTH <VTE$X_TOP_WINDOW_LENGTHDVTE$X_COMMAND_LENGTH-VTE$X_PROMPT_LENGTHFVTE$X_COLUMN_WIDTH\VTE$X_FILE_SEARCH VTE$SET_WIDTH VTE$MATCH#L)|*+,0,23ALMHNOP@TPUHVY[8_x`cpgnnvDz|~T4T0$Թ\ܾD\`$tH@l<X8|8,-1D25:H KKMSd fgl@nTno4plqsu~t8$T +  > S t ( k ~ ~ 4 8~  ~ ~ ,()[]<>{}+-*!=:/.;$_'"  0 ++S  & S 3Y G <33! !"3"# #$(%=u&: '(8*+3+,,Y, ,-8/3//0= 234344\4 4,586368=u9: :;8=>3>>DKEPE EFFSF FGGH3HII=J8K3KKL=QQT  KP 33\ X=u3\ ==  4!1! !"1"(- (0))=*8- +<,3,S, ,-806L7L8:;<@X@AXB(C D E KLMPP&V,PPQ&mTQ8Q Q0RRRJQvXW\]  ]^  ^_3__\_ _D`8a3ab8 cd3dg3Yg Xh 8h h(i j k s stt&5tu6 u\w8xx&5xy6y z {|6 |~~~1S~~83SD&56 \6 83 TPU$KEY_MAP_LIST,Ԅ  s DCo  RCk  (  X( r $`jmmo&""''")   ( (j  Rkov1P@1lR ,""K &Gx     &c  1 lu2 VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170Aj1 ,1 (s1|l+ . 8 > l  J D J  6J PJ < 6L"8T Pl 4l l  !1! !4" "# $ &'( )1)RNP) ) * + ,-1-RP- - . /< 0,2"26 68K89:;U<??BOperation cancelledOperation cancelled?  [no] ? [yes] ? yesno-Don't understand !AS; please answer yes or no~  P    1 3=u3S E   =3\ 83!=" "## $%% 'P(=)) )** +,,1{     8(  4l, 8   {  J@3HM=E &G8  =!"=#Q@ # $((=)  *P+3+/E /0301E 12 2,3 u 45==>3Y> >? # DE  JTJ J<K  L8M  OR  STTU ,V"WE` [[[\ ,](] ]X^Qb beE ef fdh kiTib ij Ll8m . nlpqqr ,su x(| ~( E  Q) E  t T  8"  h , 6 6 L     E  4E  E  Q) E  t T  8"  h , 6  \ T  8  l , , [  ^lHHH4 <6-Q6"H P3E hE    q  =8 *3Y @8 = J@J@="^Mvte$pattern_search :='' + '""(ABCDEGLMNPQRSTUVWX[Mspan('''')any('''',!SL)%Sequence count not positive - Ignored#Illegal pattern construct - ignored line_end + '' + line_beginnotany('''',!SL)%Sequence count not positive - Ignorednotany('''')any(vte$kt_not_alphabetic)arb(1)$Search pattern too complex - Aborted^M @ vte$x_match_!SL) + ';' + 't m"0D 8$  $   8 ("  Q" "L#3#$"$ &e&E  &' '<((=)8 *x +h,=-T- -,. /8 01 2 56"6  7H"9Ap d =="=  AB"B  FpG"G  KDL"L  PP"P QTQ QR xT8U"ZU  YYYZ ,[\\] ]^^\^ ^h`_``bQb"b  hi"^i  mn"Qn  rXr EsPtE/ tu u,v=wxP yzz=|   , \ \ )3  = "       d  L v( 0 !; j( p8 81"  81"   d ,6S [ "J M \"v+ VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170SP- M $" notanyanyspan,!SL[!AS(']''''!AS)!AS(vte$kt_letters!AS)!AS(vte$kt_not_alphabetic!AS) !AS(vte$kt_symbol_characters!AS)!AS(vte$kt_digit_characters!AS)!AS(''''!AS) !AS('!AS'!AS)!AS(vte$kt_line_separators!AS)!AS(vte$kt_multi_characters!AS)(^EP)''!AS(vte$kt_alpha_numeric!AS)span(vte$kt_whitespace)notany(vte$kt_whitespace) unanchor + '' vte$register_vte$x_arg_2 := '!AS' !AS('!AS'!AS)arb(1)Invalid register name - ignoredarb(1)!AS(vte$kt_low_letters!AS)!AS(vte$kt_cap_letters!AS)arb(!SL)a&(JA6 ZA  J <aKY P6-q q  m k b+Sq'=#6#Leaving command buffer#Function not allowed in this windowL_& &3   4 &   <O(&V  lX8 XK@ =^' ,' ' ( qT q 2q.RTD <2q   ]+ Y5 K - 2.T L8 x &c 1  PU=-3Q1 0&G %Kp&&c&' '(u((*+="-= /,+0Z1TS45 6789: ; AqB'AB5Bm BCDqIKJYJ JK^OkHP'Q%qR SH4Tb T4U&qV9 YZq_ returnVTE>LSE> Y(  ,p& $     ,6' $REGISTER_Illegal buffernameX    (& JQ J  J J( J<W 3=u ,( Z(A1A  U=QD t8( (U=  8 "#8 &Q) )t**1*4 *Pu+4+8,P, , -U.=/7Uj88;;v<E  <==>>>?=APA A yBUBU C$DUEU F<J8K3KK LN=QFORCCOBhT &   &:   &*#  30124 1RY #  5Rl)oQn $  !$!" "## $(%%%);4Higher version exists - Write to next higher version@,R  6:  6:(  (l 1vlR(   l##l$$&(&u''R'((( ($)1)($o))R)*1l**R*+Q+A+ +T,Q,A, ,-- .// 142Q2NA2 233 677 9h>]       <N 1 RY    O 11oR(t  D1mxR_<M3&(J=E   H $=&51kxu  w  " "s#u#$I$n$o$u$I$n$$%L&\& *P* *<1++8,3,-811=28333335E  56607777 8<===J>>A hJ  P S0 + +S  &(J(T 11J, u!! "#8$3$ l%%8 'L* +8,3, -8. ./1 u22334 568737S7 7$898 :;8>3> ?= @C3C D= E8FJJKLMXNWPLQSK TPT TUXLYZ] (Fxd R. " 6  J/ #  2w: VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170Έ_x#  4xxj& &G `! !" ",#6$$&*$ *+$+, ,+-.-&i-8- -4."s.6/ 1 136N353 3tp4:45&56 6 7&7 9,:":6< < = = >,?=@J~ DE EdFJ/<H HIJ/  JK=LJ/M?NJ/ OO=PJ~T#  30124TU V=W$YJ ]^ ^aJ bKLc&#hvd'dJ e$fJ*h&yi&@ ijJ4mK m$nn op=rruBuffer !AS already exists**2Type a new buffer name or press Return to cancel: No new buffer createdInput file does not exist: !ASCMS$LIB Goto File File !AS not found ...reading... ...reading...Set NoLanguage [End of File]?p?3     "=#$%=&--1- -H..1. .0/80 1 23313 3H4=v5t5o55 6 7$l88 9@3@@AA=B& (TB5B BhCD E=lIMI|I MMM1SM MNOtOO8QM qQsoQvQE  QR R$SS1S U,VWW1WZZ=[8 ]D^,_1_ _`9apb= cPd8e3efg3gi= k|lpm= n8o3opq3qs=tP wx { 88L   <=lM ==u:1 8 =v333SA =1 t83= 1 t83 X (=   =3     X   7   &W ( ]  86< = &5x=&5x = t83  =!t!!8"3"'(= )) )(*++ ,--//1P/ /u00s226t6687378 8D9=:t::8;3;>=?t??8@3@A  ADB= CtCC8D3DGGJNon standard Tab setting3Dh< 6$    ((T(A 86(3=P838 !K""U$H((=*E  *+ +,,=-.P / 0 244=5K466UX7 7 8<<?#DCL subprocess could not be createdCreating DCL subprocess... $ set noon81KX ) DY   \ U)# <Y J' J' &*"DJ'" !=% System buffer !AS8/K  6X ) $6J  PS0+S+  3 X ) $!!= "#6t %(**S**4l++,), -1) 12= 3 l44=8P8 8(99 : ;;==#>BThere are no windows to go to!There is no other window to go toNo such windowd,  3  ==u3==v3=h+  3 &(J=E   l H=|GtsM "P" "Ls##8$3$s%%8(E  ())0**** +/=00J114   $)  J$  &<, &V,8 K+)8 ~:<&ct<s:<;s:;&dwoxe VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170n J$!&%! !"&="$& $O% %&(&=3()) *.2K3J$466&a 6$77= 84l::;); <>) >?3?@@AhBBCDE=F#G) H(IJJ M|N&NP&V PQSS<T&3TUU VX XYZ=[ [\ \<]J$^6_>abd=fLg) gh ijk mno) oprrlsst)t uv)vwx){{|)~J$ &&V <&3  d $6> = @KJ$6V$Main.Could not create buffer $MAIN$Main.Could not create buffer $MAIN.Permanent and System buffers cannot be deleted (!K<&V,5  =& ##&S#A# #$'& '( )*/&V/0p1&(T1 182a3  45 78 :;>a? @XQA AB C0DE FGL8MNo OP^ RS VW5 XY' \] ^_ bc de k&Vkllm p>pO p$q  r  stm uc {&*{|&Fm}'}~, ~,&hY &V u Pj.v*LwLOn1w/ /1 ,R 01tMkJ'&V |J<J'E"7J'" &/ (J'+ "   J'"=Insert InOverst  LSEOverstrikesert # * Exact ><^^Free []    System buffer !AS ( Buffer !AS !AS !AS !2(AS) !2(AS) !3(AS)H  K )) lJ%J%3) \$8 ~:<&ct< s":<";s$:;%&dw%o%%&)) )u*)*,,l-4..//1u22 347&Fm8'89&hY9 9:<(=>A=B)C# E FJ One Windowh 6+.+K8>l .&G " "##=%3%S%%&&' (R() ,*1*Rk**+ ,P-8 . 3 344=5:6616 67:9%: :; ,= >8l??DD=EFG3GSGG\HH1HF H II1IFK: LP&#hPlQFQFuRRFRGFSGFS SuTGTGWG WXG YZG Z\G ]Xu`FaGFwaabGb lcFcF dj=kl nopp=qPt3tSttuuv8wwF8w wx Dz O{G { |P} ~@1tFM l8 =3SH:1 g=  $`K  3    =u 3  =v3= :83"=vU=8$  | 8  (~ @ D     = @D  =(~A 8 @1:   (~ @!D  !""=%%(<,    =3SE `=l: T    !!=#3#S##$E $%%`&=''l(())*: +T, ,-225 K  U 3  Y    & &dS8 8 3 yz3 1ѝ|F /08jp@i*H=eB/ ".IC\7]zH3[&W8>UHrmq#et#U'+uQi2LFt: cJ+˴M7abz8Q Z3h\KezYuϦ հXk4.p­{U9wŅᬝ̢Tp9W`ܮ$BToָQs"(jx3Q5Jx:%NMWG'Pv}^4Xk3 @`"Ѻ8ڜrdIO58m{ ~sY)Ao-D(Bd[L>^ FQUo>'z7;%)@@.q"3ۇ@ΝŽft߰3g/趈ծʚ*Ud$xVyNY])WzRQxQ1cqwvE|k 1Y:t;(y*he/cHo `$p<X̓5) -k駻Ơ M|91Ё"rZeNT&?9 9.5U6PN-?mj$LtP{W<0xf$;ٚCӏ~y>qx) vV"cSa<2r ~FUihCn]z 0o $#TKi ҟC0:p7+R]\~繒tԱ„o8œsY:z3F.,/h*Pu}l[D^i!R`Rm;qJYu{J6pץ6l¹ HSDi6Qm2'T*9aS eOd+^`1X7WN;y Q(l,MVGMceUX,sUM5QQ\Qk WA@rq Q:Niv/p7tmɖ/hљ)m{vI3˭6۔יyrhirL1UYE/gaXb+NQ7u O[ [K SBx-23^ i %%⡿_7c6#*dhF``iqsonlX$t_nzc.F'{|.#l$3$F\Y#B&t >ٴag3z1MwW۝G.[9%m5EWRwq0QVw`_c&@\ /g*"4\ h(=kaj+%](=@/,SB<~S1S95ScE8$'V^CiuN=%TzvVARz1vL~=j[6k2 :%x[W|DstY)^C'P_l[4~Ad |A4&}_Gtm01is G.ݜkZݙ3~ͭ7&%{@ENь0?;pJyp6AoNay|k\k,-mQm4 A@FD=8xȱG>u &L.zI4۠blge _Wi̜ݝ^Ŧ]S]?t%?ǃ0g#4$\vM*)mf-lAKHR70F8N9\Un`&~JR:/D 07, -N\p,d %J cJKv0 7ZVH$3y 90vw<`rmnE^J:ɸ5O;85`pwci1tQR25pt;fNJޙeod! ݥ Gg{`Ēq/9)3<p073t<&1)^#50L+e|c7ކ"<9M~'q\2HښcOđ9<d/{/fQW $A0/:nȫlcӗb#CNs=AD'm4yL+&/@bn`Bmh(tsQTԖ[î~YEq\oQ>,EZ>fʚah>nu\db5 ,z`4oZ<"ĕI*.E?x*.e 6uPnSzWj~[dRsi|*X nL\j>8-,Q` g(!w m.P0&?^ݢe7U]aB(l.9yC{m!,^geo;N5!A4]`9/!?:~5qpaZ6Qe(="\0GU.;ogNqÒ&Ęahu}{mS/ >7?oI,dɒ"Cm'9.=!7.b2d3TF=3Qȏa잖~e"$> h1=)#wC7\%dsv%K?,:Hw=14ahTw Q LϾBl|f(t~0O3}S-gfct!L|zmDzMu-j%_6CųlYѳ6#;,yuv&'scalF 2yIH{f G106->k6d#0ҕǀd! q{d[I[7$7&3ȧm´5қ: N#k4W,Yo6xᓳ*=sP$\!F3hQH]E2c,Bi pzz kk9h7=+}aN>h&-o)~JKLnG>chB\F9~#Y]RX=L2c.m2(5oa|-R?eɻ53s4_3ݏc-=Kjl0B$}c0s9xƍ 9??g tLaN\'Y'ci?S(_N:ip Ɩ,X 3xIVdW6}R]+XiGkDTAvMFCawq cRZpCRPgof,[~މ4vVXAd@L!MD_?M!Z8rX+_\bĠT=v4rJCMSaE }}y:nE/mِue_i.g4,wz?_f-NDCS8|M%S(guuaIAW\RT]@'ֺN]E@'wLq=;dV1i|II%)}ysV^k~VOb8N>(xQe + @|1yxcyӈ5U\2ZNLg*%ι9B\rs2*gAg(b (&,M^ v MRVnL:[?$:19(TޛR^%P ٭s("[ctX>+W)@4墢p8~=sDOO5 >B_}FFyNSP.OY4DfiD?;aqtL%=Cv`Z|fuXї-sDt#Dfa{:Ls~^iuu-}}w<1D/iQOyt61.>#c `xsO *JH; bf(+ hdpr e>kh.Yg_-sG:-FUwrG.ImXqLp+spy aOvS`tv/##ptH~ 1@Lf .T'hf$Gν[-#d~1ݿUsZP?haKg9:mgƤS;ګsDk5}@DXH')S& XMA36XVH?J5VTO+lGHsjYKLw$_-[pEƂ iN" cVZ(6S2N>"x|{I1ڡ/gt %t~]|紐8&KTn6GY]!GX*QTpuG<%Q  sO!VBΞF!_7&|"o8bo?(,x ;-HNS3"c3?+nӆZNYp=<-`jf*rSLjQi'J[\h>dPgS`sWpn#=mcyW?uEa|$w{s^5Fv ?É:3 yN]Pܰbi ,i0ede`*gC3w gO9g:Ŝv)Q1d*IJD/q5EbZKxΝtB"4lrr5Qm*i 燐o qul~y`6/Gđgc8'Bs"bI&B2*7(>zԫraaua0]c/ro67ԕ10 Q5S{EX1#?]je#f_pҕQvcʊT=ӨpW\>*(;lEn~) }aщӻT֝'_#Ҋ։Idߟ5<9&ȶ/[xHxmq+-b˄z]A_jrGt#Pyf g@sgVi>AuɎ֐/i\jaj<ЉjB*ىR5ûw*ׇ7#Å*@a1$B$"@0T@F6L72ʑyG8̊Mde~~WtTm:=1AU [nE}\?ݪ L}z$ԗ 6Usa3z"`Dmbxjl4%|\e[8>;j"p><dbz,'|q0vd5SHAc>9v$z}ٙyV_PYA=CEX~rMTG,12~;ʺjimFjy_OJNnH qd+>: }j%׿,GF-MG;OiI8zAsmҕlNe" &a5Xkq2sy:րWeFYZ|O<.;2r1:;42-5/_2W<>5\̍uhKeeN%@2-m]!.6QtRo^ r)Gv=jԇJdxS.Eai͉B؉:z`}2(QdsKgn;Ƈx>-2$W1^oh!-)uBm?ku,u3q 4cB' Ig[kjLcLˀ@kZvwHy_9tTCvcF=7 Kyto,Y>eif-(ҽD7bgH\FF) BRfSF<#v㹲L`ٯyviPz(e$C~S+ܼ?>UA  <0  3|  =  =(xuR P1lR d =!  &V>N  L y&Fs>P  s3&5s o  O!A! !4" "L## %l(()3)+&5+,,h-3-.///000l11 2p6&56O7 78=;<P=P >@2 @A2C&5C E=F&5FG GH HHI IJ KL N<OPPP QS2 ST2 W@XXX 8X XLYY ^    8 3Sd(~808l t(~ l8(~ 8  l!! "%%( t & ( J :=u2 1& 5D 3  S  !8 "#3#%:&2&x&&8'((1()& 5x))*3*,& Fv,,- -.=/1M 1E  12233 34= 577=889991990l::;8 <> >|??F@t@@B=C E E4lF F GM HE  HIIJJ JK= LNN=O8P PLQQ S 5SQ+TQsUU 8UAU UV N X[=y]Q]Q_8`J c  H &(J318 qsnE   p 8!!(! !"8 #$$=%J&Q---1-8- -X.E  ./ /$0=1J2Q88888991989 9H::(: :$; <=uBeQC CLDE  DE EF4 HHII(I I$J=KJLS TE  TU U(V1V V WW=XXY YZ8\\\(\8\]](]8]Z^8^ ^(_8`Jac12cccd8j jk l&5xllQmJQmEQn=8nQo4AoAo ojpp rsQx>xy8y y1zz <1v L    ~~w  XL)  L t~Kw s  L  = D3S 8JCOMCOM COMCOM *FOR 1 1COB   L  X  &GA&GA8 0KL L=M   !&3&'(+ (*+*u++++,,Y, ,d- -,..=/81E 1 2355 64 89 9 :=;8>+>l?+?+@@Y@ @XA A B=C8EE"E FGII J@L+PXQ QhRS= T$UUU=W]XX Z[ [4\=]F"]^L``a3aa\a ab8eff gg h iim|3J   =  =dD K = &cx  $0 0&L&K&JJ%=J%! TK  VRT[8 V1 0R 85K   Q dQ ,&:Qo # ,$${TPs VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170[$'"Type a letter to select a register:*_K=  U     4yl, : # 4   1  0 1z M k  (r <lR  .TPU dH 6 J@  6 p6)@6x)?n63Q * !6!'RT' '(3()1x))R)+$ +,$, ,h-$ -.J@/=0?1J@ 34  67=8 = =D>>=?E  ?@ @A=B8C3CCCEE=F8GE  GH HIQIIKQK)K?MM=N8OE  OP PQQQQSQS)S@ U`VV=W8X3XXXZQZ]=^^a&Could not find out editor default fileLSE$CURRENT_FILELSE$START_CHARACTERLSE$START_LINE TPU$MEMORY TEC$MEMORY$ /FIND=(88    hjiCD  i RC( lCC  C"RC"Q% %8% %&&Q**8* *4l,C,C-h..2(2 28l3C3C4RC47(7 78h;(;5;i;i=(=5=h=hl>C>C?CD?L@RC@A(AA BDsDCDRDDGiQH"QHAH HhIjJlLCLCMCDMNRCNOO OlQCQCRCD RS TTVRCVXW WX Y \s^C^R^`aa bjccciCDiTkRCk(kk llClC mspCpRpps__@_at_file+-'"(]  6P &   Y 5 K Q ) < P  = =Y 8KJ$K J$$"Selected position has been deletedP<=KU   @'= '=:D  1 8 $1x83KU!48 3=u   = (  ( 8      t3G(]  6(=3\ :=u3="=u#3##<$0%E  %& &p''=(( ()8+Q+,8..&5x../4 /\Q0zQ1uQ1m81Q2dA2A2 2s337 j88 9Hj:4: : s;; <=4ABBBBB1SB8B B,CDD1DF: GI=J LO jP2P2 QHjR4R2 R sS2S2 TU42lY2YY&FY Y ZlZ2Zy\2^_ ` a dNo range selected *FOR 1 1   4 Y 8 &5l2 x h 8Q(8(8(8 42  8%%%1S%j&'('(((Q(8(A(8( (,, ,--1- -P.3./=u001= 2309(9:( :;(;A;8;<(<=( =8=A= => ?T@(@A(AZBf8BAB BC2 GHHH1SH HZIIIAJ JK2 LDMM M0N(O OP2]+^U^Y^8^ ^_ ,a +eNee&5xeff&Ff8fZf8f fg3ghiPj2k2kxkk8lmm1mnPo8pr=uv yFORFOR COMCOM h    3  \ 8  8l    3\8 8u    \Q J Y 8  3  2  8 E   = &(|-Ut VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170J2: J:COM\QY8 @8 2   COM$j( R 4 K+ U+ RA  ( A 8 4( 8PR(8 ,8 8j!(j Rj"% R   ( xR( 8 3=u(  :!3!"=#=v$3$%%&=''()8j**++.8/3//1E" 1 2 2$3 334= 66(6 6\7( 7 78P8 898:Y: ;;;R<( <A< < =8> BCC D8E3EEGE " G H HI= LdMMRSM M uNN OlPPSS TtVVW W0X=uY8Z [8\( \ \]6`=cNo matching parentheses foundl(]    ,  &] C D &* " 6 Y5R ( 3\ l83Y $8 8 ! #4$%(%A% % &.j//(/ /<08131286#Key !AS currently has no definitionXj( R + U+ RA 5  P (   R! 8td@ " 6  6&&@,8 0&&: 0#  2    l  $#$% % '# ')+) +,6t0'Don't understand journal file name: !AS&Editing session is not being journaled sys$disk:[]tpu.tjl.tjl&Editing session is not being journaled@K 6  3  ) &Fm', ,$b &hY = &hY  !J<#$%='U*+,)-# / 04There are no windows to split Two Windows@ ,   = $   =  3\ 8Dd  =u `  !!"3""\" "#8%Dd" %&=l'' (`,/L:`$BBD DE FGI1IKLCM1MDNgO P Q R S T U]]_ _,`6@a ach<d"d6e egh ,lRYl l$jmmnq%r4%r(&t@'tx4v t(s! s r u!;uxx y9 .XuCR"6 PuCR"6   =    ! " # $ / 1 3 5 7 0 2 4 6 8 Mqs%  , pu u"D$t X j lv0j%(l(v/( !j m%o=m!lv2j%)l)v1) `"j m%om!m%om"lv4j%*l*v3* #j m%om!m%om"m%om#lv6j%+l+v5+ $j m%oim!m%oSm"m%o=m#m%o'm$lv8j%,l,v7, 86=  =3S<E ==3S4:  83\ 8P=: &G =    =  lmm &G  Xu$$"%$Dd &&/}C VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170w&'0' (|(1&)2' *\*3&+4' ,<,5&-6' ..7&/8'2&'3@465= 6 6 748 8$9: ;D.EFSuICIRI"OI JPuMCMRM"M6O= P P Q@UU=VW X9``laac cd|g5g9 g$hi j<upp"q$Dd rr/&s0' t|t1&u2' v\v3&w4' x<x5&y6' zz7&{8'~&'@6O =   (   =3SX&   : &G  =  .S  uCR"  \guCR" 6=   8= lR 1lwlRkS   P&    &  &  p  ,!;O  D lL   d&G5 .SuCR" \guCR"J6=   ,")6 0 "  6     8l  Qqom ,!;  8 lAO  l!#l  !(!A! !#Qq#o#m#o###$ Q% %,l&&' (@Z) ),*6{+ +2 ,3 3l4I47 7l8$8 :< <l==??lDDE EF H HIQqIoImIIJ ,K!;K L LM MlNNOP lQlP Q(QAQ Q SQqSoSmSoSSST QU U|Vi,jWWX Y@["G[6\ \ ^@Z_+ _,`6a ah ij jjj kOl l4oopp q<rrls|msosns{{Q|L |0}}l~*~ < 8 l No valid commandUnrecognized command: !ASvte_vte_Don't understand command: !AS1Don't understand initialization file command: !AS__________Too many tokens_Too many tokens _Don't understand command: !AS1Don't understand initialization file command: !ASToo many tokens _Ambiguous command name: !AS*Ambiguous initialization file command: !AS _ vte$arg*_) _Ambiguous command name: !AS*Ambiguous initialization file command: !AS!AS command takes no arguments&!AS command takes only !SL argument!%Svte$arg_(  return(vte$arg_)integertpu$k_unspecifiedstringBad argument type"",)vte$arg_(  return(vte$arg_)integer#!AS command expects !SL argument!%SstringBad argument type"",,,|= 3 S  (  : p &W(] ,6 &5x3&Gx:3=  !8"t""8#3#(()=u..1. /  /808 s1 M1}1  2388389=::1: :,;;1x;;8=3==>8?3?C=D EPEE|FFF1SF F,GHH1HJ=uK: L(PP PQ8S3ST=UtUU8V3VW=[\ ] _`XcNon standard Tab setting 0pRDK=U.K=UK3|"$ $\%&&' '(  )* ,t-g. .$/6 081"t1626=7gX8L9+ 9:+<+=E?l,@ @'A' BC CG+GHEHJJ J8K KL6l NTQKRRT3|TuU+U+ VDWE+[g\.]3|]^g__=`3`\` `a:bd= egK hl1k1xlollRlmmnno6:,s(s spttu6:vSpjw& x xjyy}3|}~~=3\ : = E +SNo previous commandDoing previous command: !AS&Repetition did not finish d~q+ VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170ue to errorvte__ DK 3|&G  6 #) #l$; $u%;%'& ' ()U + u,=, ,u-=-/) /0 124&L45&K56&J67J%18x889U<&#h<J<=>&7v?x?? @ BB=C8K3KLL1LwLLF LM=v NuOFO8Q3QQR=SUU U2.U V 6X X0Z %\j %ff p%id |%oh %uh %f %e @%h 4%i (%i <%m 8%f ,%d %_ %] %X %O 0&H @'? 4 (]3]^=u_3__S_ _`8 a b=c: \g: fjk&czkk:l=um8 i,pp&cxqq:r=us8 ovvF v 1wFw8 xy=uz3zz\z zD{:u}GG}Fo}}8 ~8 u1mF 8F 0z8: Q  o  3=KP =*34FIFwo831wF =v uF83=UQ  6 L == p hQ  6  (%   (- (  lm  k  3=3Sp ,%,8  : p&GT `=:Q U 4&G  8-2 Y 3S T8FIFwo8  T=  =8&Gt   8 = ) ( Uj  s    = U 1 ) ( U PlJ%=og% 4 6 ! ! "# #'Nothing to selectmove_up move_downprevious_screen next_screen move_left move_rightmouse_position mouse_select mouse_pastemouse_operationfind find_nextselect this_filereturndoquitdo this_file mouse_select Nothing selectedpK@+S+A     Y 5 S 8 +    Y+^A  xmkbq'+S6 $Prompting cancelled,KP &#h  &#0   &@  & d&)&V,8,&3  (J@.!9!"5"K "h#J*$3$%=& 'U(=->151K 1@2J*3=45=8.9J@:KD;<=U>?CD Buffer modifications will not be saved, continue quitting (Y or N) 0} h ,l  9 p   ~ d\ 0 "._FLAGS Compile $ Compile COMPILE !AS{   kKdY8 @3|== ^|'k0 (!K"%^ &''(+6,R], ,-,/010RP0A0 01k27K83899=:&G: :d;:<<===X> >?  AB DD=E=JR]J J0KfL6NQ^R'4TKk TUUYVTE>Command:!CONTINUE!0x T  x " 6.@K(  6 0#   #n %%& &')- -8/#  24/ 002#  2429&9: :; ;P<&:P< <= >? AhB&:PBC&PCAC CD EFKPK>K KL4M"M6 N,O"O6QQ R4SKTTV= YdZ Z0[[ \(]]cK(dd ef jN+ VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170)Don't understand file name: !AS LSE$SOURCE LSE$SOURCEsys$disk:[]*.*;sys$disk:[]*.*;Buffer name !AS is in useAlready editing file !AS ps 4  Q A d&*#  4z z PRT# O O R !!&F! #<%s%&O''z *,s,-O..z02t233{34 4T5(u5 5,6x677{ 9:BC DNEPF4G5HHyxHH2IeJRKULM N O P Q R SW WXwXYOZvZ\%^M |%vE $%= %5 %- L%% p% % & '  _4`5aRbcdefmkn oM onprM sqtst ^hw4x5yRz!{|e}~M nvM qs vNP5 x5RMC9/& 45RMnM Mnk nM nM qs R N 5 PO (6PO  Oyx2j4528Z824A 42lz h32O2 2RzzJQ{8 ({Z8A  $ t   t 6 Xp (u  x   Z8A&GA { (  &F l'2' '(l(2(y)K**&hY* *Xj+'+,, ,-,//J<44 455&G566&),686Z787 748499J~>change$COBCOMDOCDTRFORMARRNOTPUCOBTPU*!()!!"([<)]>$!!"([)]CcDd!*!!;'();;'([<)]>([{)]}'"No such formatterchange$change.changeCOM|e$ $   ((A(A8 T$h (K,6D 3|= P  P!$!"" #$& ''( ,)*=..1sys$disk:[]*.*;*%...sys$disk:[]*.*;Ambiguous file namesys$disk:[]*.*;c = =u 3  :=8-3 @b$   (    (  !; j( $py 1 6M "Type a letter to select a register vte$register_vte$x_arg_2 := Invalid register name |`( T     8 4J" J   t& \ 4  ! "#G# % && ()*/3/001 1|2P2 2(346 7<838388O> >??=@8-A3AA A8B3BBBD3DD D8EE3EEKV,LL M NOO\O O\P=Q8R3YR  RSS  UVV YY=ZZ\Z Z [__=``\` `aPb:gh9 ij ll=m3m +nnnYn 8n no8rsxy z {3{ X| |\}3}~~= =  VlZH6=3 0!1" /#$%(&T& &$' ( )*+9,R,(x,, - - .6 /1 Q3 34 56 "? ,phpP CC CD D E8lF F GR G I  ,QM MN3NQE  Q R RLSQ S T) T1U VW1 YZ %^ %b %g %p \%t d%~ % % % % % %z &p 'f  1^1^1 ^b3c&ѐ VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170c1 bg3gh81jj,j)j" j)kk1l= g p / p t1 t4vv1wwww1 xy2yy1 t~I1 ~/  t/ `&G1 43E   LQ   =) 1 1 ,)")1 6 pm o}v 1 pL o\U 1 8p+ o;4 16  p o 16 Xp o16 =  1+  1 p / $6 ,F1/m 1 ("/ 4d "/0 1 \"/0 1 , "/0 1 4K5  5 ,== U= 8+KQ 8 6" "0# #$$ %d&1& &@l' ' (R ( ) *Z0 . 0T1  ,2( x22 3 3 4xQ5CQ5C+686A6 67 84Q9C 9: ; < AEF1KLM=pR oR/RSSW WX+E YhZ2 Z[ [\ ]^6`Sb+eInvalid numeric argumentInvalid numeric argument-+-.ADLNOQXZ\^!^!UW Character: !UWInvalid numeric argumentvte$x_arg_1 := vte$x_arg_1 vte$x_arg_2+vte$x_arg_1 := vte$x_arg_1 vte$x_arg_2-vte$x_arg_1 := vte$x_arg_1 vte$x_arg_2*Invalid numeric argumentvte$x_arg_1 := vte$x_arg_1 vte$x_arg_2/Invalid numeric argumentvte$x_arg_1 := vte$x_arg_1 vte$x_arg_2Invalid numeric argument+Invalid digit for current radix0Numeric argument: Radix: !ZL, Value: !OL !AS !OL0Numeric argument: Radix: !ZL, Value: !SL !AS !SL0Numeric argument: Radix: !ZL, Value: !XL !AS !XL"vte$x_repeat_count := vte$x_arg_1 vte$x_arg_2Cannot repeat that key|Ip&   &V X &T " 4 J  Jc&3 \p)   Tu "H    &cx   &h H  L v J  =* GH 6 J@=OOA?8OB@8A&@A 6 nn0 "c 7 #A#B8# #%"(AB%&n\(" B(7(*"A*7* ,-464Q5 506767 89<<R]<]A< <x=8?"7?7? @0B"B7B E0F3FG1xGGRGI$ IJ$J JHK8KL$ LM8MOP=Q SJ@TVUJ@W=Z[^!Could not set editor default fileLSE$CURRENT_FILELSE$CURRENT_FILE !AS!AS /FIND=(!SL,!SL)LSE$START_CHARACTER !SLLSE$START_LINE !SL TPU$MEMORY TEC$MEMORY$TEC$MEMORY !ASTPU$MEMORY !AS( B K  , ,* * H*X,8 , &=! &= "& "# #pX$X%8% %D& &'J<)J< +`,&V,D- -.J<0J<O33,4&=34 58?L? 0++ S   (Pu 18KTY28ZX8 2 0 2Z  8 !2&COMCOM|>=3S86:  4=K<&V,5    &% &`& P &3  D # [ ]    [!6SL]!AS1Line mode corrections don't work at End of Buffer! [!6SL]!ASx/  3| J$=K=*J$ D 4O ="l. 3|    PPAPA (==- K  6\ 3|=&|l4| P =!" ##$ $%=&)U* +=,-- }..=3E  344,5=67P 8:; <<==> >??C$Function not supported in batch mode Selection:/Command:`*   0 3|   =H*PPA   X F"   (  6p `L0LF" 65(Previous rectangular selection cancelledSelection cancelled88)oo   3|P  6U3|= P P    !=# #$%(%)^@%,Wp%/O&2J'2C4 2*+6 )-.6 ,T016  /367AMove to the end of the selection and press the mouse button againCopyCutRemoveCopyCutRemoveCopyRemove%Text was copied into the paste buffer$Text was moved into the paste bufferImpossible selection,%  %\ <&T  83  KP P    8 8 hKPY  6  %#Function not allowed in this window8$+5S  l3\ $   = |#&: (&*  #K=v&5 < =*  1  T 3  \   8 =v@M4D8dh XTPU$LOCAL_INIT@VTE_SHOW(&VTE_SET_SEARCH_ORIGIN_CURRENT$"VTE_SET_SEARCH_CASE_EXACTFVTE_DECREASE_INDENTGVTE_INCREASE_INDENTpVTE_GET_ENVIRONMENTVVTE_SET_MODE_INSERTVTE_SET_ASK_DEFAULTCVTE_RESET_INDENT5VTE_INSERT_TEXTVTE_SHIFT_RIGHTVTE_SET_TABS_ATVTE_MOVE_RIGHTVTE_SHIFT_LEFT VTE_FIND_NEXT VTE_MOVE_LEFT? VTE_UMLAUTB VTE_INDENT VTE_REPEAT VTE_COUNTiVTE_EXIT8VTE_SORTVTE_EXECUTE_TPUVTE_COMPILE_TPUVTE_TPU aVTE_ERASE_PREVIOUS_CHAR VTE_SELECT_RECTANGULARVTE_EXECUTE_REGISTER.VTE_INCLUDE_REGISTERVTE_ITERATE_REGISTER,VTE_APPEND_REGISTER`VTE_ERASE_NEXT_CHARSVTE_SET_CASE_UPPERTVTE_SET_CASE_LOWER_VTE_DELETE_BUFFER0VTE_SAVE_REGISTERVTE_ADD_DELIMITERLVTE_SET_FORMATTERvVTE_BOUND_CURSORVTE_STORE_NUMBER+VTE_ADD_REGISTER-VTE_CUT_REGISTERwVTE_FREE_CURSOR~VTE_SET_CURSOR@ VTE_FORMATTERk VTE_BUFFER VTE_STANDARD_DELIMITERSVTE_CLEAR_DELIMITERSzVTE_DISPLAY_GRAPHICSVTE_COMPRESS_SPACESVTE$ADJUST_WINDOWSVTE_CHANGE_WINDOWS|VTE_DISPLAY_BLANKSVTE_ALL_DELIMITERSVTE$STANDARD_KEYS VTE_FIND_PREVIOUS{VTE_DISPLAY_TABSnVTE_LIST_BUFFERSVTE_EXPAND_TABSDVTE_INDENT_LESSVTE_SET_ASK_YES VTE$LSE_KEYS VTE_SET_TABS$%VTE_SET_SEARCH_ORIGIN_TOP VTE_SCROLL_UP VTE_MOVE_UPVTE_HELPVTE_TOPLSE$$UPPERCASE_WORDp LSE$$EXPAND #VTE_SET_SEARCH_CASE_ANYVTE_SET_TABS_EVERYVTE_SET_F) VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170/tNOVERIFYXVTE_SET_MODIFYVTE_SET_VERIFY NVTE_SET_FORMATTER_OFFYVTE_SET_MODIFY_OFFVTE_SET_SCROLL_OFFQVTE_SET_MATCH_OFFKVTE_SET_FLASH_OFFHsVTE_SET_WRITE_OFFTPU$INIT_PROCEDUREVTE_TRIM_TRAILING cVTE_ERASE_PREVIOUS_WORDVTE_EXECUTE_LEARNED7VTE_INSERT_WILDCARD[VTE_CAPITALIZE_WORDbVTE_ERASE_NEXT_WORDEVE$PROMPT_WINDOW VTE_PREVIOUS_WORDVTE_GET_NEXT_WORD<VTE_SET_WILDCARDVTE_LSE_COMMAND2 VTE_LINE_FEED1 VTE_FORM_FEED  VTE_NEXT_WORDVTE_FIND eVTE_ERASE_START_OF_LINE WVTE_SET_MODE_OVERSTRIKE VTE_INSERT_BUFFERNAME!VTE_SET_SEARCH_CASEVTE$INIT_PROCEDUREVTE_INSERT_INFILEVTE_START_OF_LINEVTE_PREVIOUS_PAGEVTE_PREVIOUS_LINEVTE_FIND_REVERSEmVTE_INCLUDE_FILEAVTE_SET_LANGUAGEEVTE_INDENT_MOREjVTE_APPEND_FILE3VTE_INSERT_DATE6VTE_INSERT_TIME\VTE_CHANGE_CASEuVTE_WRITE_RANGEVTE_CENTER_LINE:VTE_SPLIT_LINEVTE_SKIP_RANGEdVTE_ERASE_LINE*VTE_SUBSTITUTElVTE_CLOSE_FILEtVTE_WRITE_FILEo VTE_READ_FILE^ VTE_UPPERCASE] VTE_LOWERCASE VTE_THIS_FILE VTE_WHAT_LINE  VTE_NEXT_PAGE VTE_NEXT_LINEq VTE_SET_WRITE' VTE_EXCHANGE VTE__AT_FILEU VTE_SET_MODER VTE_SET_CASE( VTE_REPLACEg VTE_RESTOREf VTE_REMOVE= VTE_SPACE8 VTE_QUOTEVTE_LINEVTE_TYPEl/VTE_SAVE\>VTE_TABL4VTE_INSERT_NUMERICEVE$DEFAULT_BUFFEREVE$X_MAIN_BUFFER HVTE_INDENT_CONTINUATION $VTE_SET_SEARCH_ORIGINyVTE_SET_RIGHT_MARGINMVTE_SET_FORMATTER_ONLSE$GET_ENVIRONMENT VTE_PREVIOUS_SCREENVTE_SET_LEFT_MARGINZVTE_SET_MODIFY_ONVTE_SET_SCROLL_ONhVTE_EXPAND_TOKENPVTE_SET_MATCH_ONJVTE_SET_FLASH_ONrVTE_SET_WRITE_ONVTE_SCROLL_DOWN VTE_NEXT_SCREEN VTE_MOVE_DOWN9 VTE_RETURN VTE_LEARN$ VTE_SPAWNVTE_SET_ASK_NOxVTE_DISPLAY_CONTROLVTE_INSERT_SPECIALVTE_RESET_JOURNAL)VTE_REPLACE_ALLVTE_SET_JOURNALVTE_SET_SCROLLVTE_FILLLVTE_DCLLSE$MESSAGE_WINDOWLSE$BOTTOM_WINDOWLSE$MAIN_WINDOWLSE$TOP_WINDOWVTE_INSERT_MARKVTE_TOGGLE_MARKVTE_REMOVE_MARK VTE_FIND_MARK VTE_SET_ASK`VTE_MARK;VTE_FILE_SEARCHO VTE_SET_MATCHI VTE_SET_FLASH} VTE_REFRESH VTE_ATTACH$\xH## $ $ X% L& H'' ())L/802|3355t88::d?BC $D!D"(E#XE$E%F&8F'hF( K)N*$R+0V,V-W.hW/@Y04Z1Z2[3[4\5^6_7_8`9`:\a;b<pf=f>g?hh@\jAlBlClDmEPnF oGppHpIsJsK,tLptMuNvOPvPwQlwRwS xT@xU`xVpyWyX zYH{Z{[|\]^L_`Ȃab,cdeXfLghȉjkTlmlno@p@qTrst8u@vwxdyz{,|} ~X|lL8dtDl$Ddt`H  $!t##\LpLLLLLLLLM$M  D +  + +S &G = $=DS$+     $64 $ 2Insert special command requires a numeric argument  0 + S + Kp3Y (&56:Y5 &b  &w  ! !"% %P& &'s)))  *+ ./Y/X0X080A0 0t43Y4 4(55&5568:9 ;<A  0 + S + K418Y5  1 018  0 + S + K,8Y5  (8  0 + S+ Kx3Y (&561:Y>_ Y5 !!&""&dw""# #$' 'X( (1))s+++  ,1-- 0t33Y3 3(44&546166:7 :P(=T= =X>X?8? ?@&G@A AHB1 BC1yEEHH\H HI JLM N_ OP S(T U V_[  0 + S + =u:0  0 + S + =u1:d 0+S+   l( 0+S+  1    0 + S + K@&cxG H- VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170:=u  0 + S + K@&cxG H1:=ud 0+S+   l` 0+S+  1  K 6  J"      J =u'Scrolling needs a window to be scrolledK 6\     =u'Scrolling needs a window to be scrolledX K 6XX8 8  6 3=u  (  P!; !E  !" "#='3'O( (@))1)w)x))8 *++(+ + ,6y-/ /E  /=0823223844U5Q5O: :;$ ;<$<=> >,?@$ @ A(pBHB6C EOI ItJ&JK K8LLMM OS)*T$ TV$VWXAXX<Y Y Z$Z [ ]_ _X`a"a abc ef6k*k)8k k lp$Function not supported in batch mode;No wildcard has been selected - use the File Search commandNo such bufferCan't find file: Edit file !AS No more files  h3"  86HU (  6)Previous selection cancelledRectangular selection cancelled( T  p      LL x PGGL   ##8# #p$3$O% %&=+'X'3((\(8( ()8O+  +,3, . 0+1X22Y282 23853P5 5H6=O7  7838 : ;<=@6 CNo range to skip over|+5S ,+S ,=u  @&*PS+ l  &G +  =+ $   =  S+ $ t& S  $=   t &  !S! !"  #$$$$=&  '$(((=-0$L$  , =    63P    X  4! !" #$ ( )6*(1T11t234567 7 86n9 ;|?B You have no marks to position to(You only have one mark, and you're on it All your marks have been deleted|    3" 3P T      6, 69,You can only delete a mark when you're on itYou have no marks to delete3P ,6   Mark at current position removedt ^ , K L 3 = =mK X3=  =#$&G$8$ $%* *++,,--Y- -8.=/80302=33U899(=T= =AB B,CC CDJ JKJ/MMNNLO O PPP lRR STJ/  VW WX\]^_`Ld d4e"e6 fd(gTg g4h"h6 ij6qmIo=rSearch and count:...counting...Found !SL occurrence!%SCould not find: !ASString not foundp ^+ 0 ( p K L3= =mK |3= ! "=#$ %=()&G)8) )* *(+6, -d(.T. .4/"/6 016667 7d(8T8 849"96 :;6@Search:Reverse search:No previous target to findFinding previous target: !ASFinding previous targetCould not find: !ASString not found88S1++  0 +S    d( T  4 "T 6 68+SCould not find: !ASStr凯xq/o: _vU9^iA75Lι'Vjp&ospz DIsNwfy1/ lmD-P< )(&7S@i]5Bag"9\~-Ȋn/faņ=cEz?#43bV5^T^SF\RTұS5Jh fz^as'ֽ(QGX}/(Q_MS`NaCP,s}HZ_@9@PE>SvtX-^DS [6DTFUfYVPWbWOObn/0Z_RHTR)uaO%U ^F!DJTgWѬkq9W^EIEAItUZP.LkL*uSs_K_EED5X2 TV_cZDv)^2FQ0#VHD\Vw_SE:]P^EmLM2GCV^hFONsE OۻPPO6#(R=:,&(i3 &%2,m&bAc=;H_CϭIV19V%LMT2PATC :kRTh_@r2R|GL%0ySTRR8],M# $VM_RW3MWSD[&S"*-:(E(0=lvni on (H7~*?.2iSDW_LgFk^jM^EJ ZUtW_zI8@.G^AE0YSa_N) ZEUW ReU]BFH v+oY _E@xQEZx JJX0QE3TU4Gg i[|C*HBGUC UP]Ui]pT\i?I0 " j0SwO{\~MJ\2 5yQXRIAM2 #% aR/AQvVбE > {S_Z|F@;q* S!\C%TDL [DrZHLEu4Q%ک^STs^GlWUDYDI " b VQMˬ.;]_)O6ERSX{W^B Gh $ Q 'U$_VH8Me9/mQ }KS1tc" PC_CEիN#@ Tp_tOf_!]Tt \ޠXrIL4EZ^MHeE ϣK_IܺvLpQK_DX4Z %W^JLoCu;Z -VޡFǪwu S_FF3WϡQCUE(Tg^T7ng T!^gKEmj _V^Z!!n[_EGEB SQDq5.T}AEyRIOLR~Gc (X2Gݿ:Oj^-U&GRAAzV5$_mTOCG4M8 b* ]gSL5Vce[o !h}iT YC*^ uQ^`DEf^Eء0ETBHg:>Sd[ *"=OHwdlWt3=g(e68qAY5&hv17?+ -$ N"BI @ Z'5"o+j1|;1d301C5i/`!%o 1#2"/#Z;aR]0_AJ"V^CرOFv=zCDac.ϱwjr9raR!n$#!h|9 a?s)aNuR7\"ca/G# t7:`);DdRzc- :k0G_8{c*^f}η?[D>&dހJj`h?@k G v$ R)3l2r?SPhU_!AFlWD3LsnMTeNME_ OP@S_ EFvL0S?^E^NQ @M,!uCU=NqCfC UYI<`K9K9#Y-m-pchu.=J\u`fgD DëF 2-9vc{9gK:-o<bZ 9qw' ݞvap.~ss ֜%:gsc`981$U1r_">?.v~h<(v?H)*9Kf2$::"}_"\Tv@?qnXS}bR:[jXqYA -oK`͐hPL7 zcgIìp3s(6--Ncf?34^"v6vf2n( B0 =Υ!=? r^Iene: !igrB]uHvgxuY+5beq-aPH:w$|sgf>m AbsKOT`qk1#(Ix n*$sZ: Ĝi0U>ei3ujwz`!s`,/!MpR#Oh.~۟Lgj d eMxq[XG.Ʃ]e'^R !uRdvkewsu@ME#K`CދM"|Z:v#Rw }w<8q~no# zswhe_+eK2QV~oq `Wexmƶ!毘=>ikțCqzvE")iđX&ߧ m7ev egnn ꌜGt <hhgF@_0+O!oޚVn{ %)5ҁjE,![zk^aNݜϗfۉMpc|Pe)#`G܉^h9g8C{y[NHyH| dSc`tDž'db(g;ܩx+6pUdujNep0d+b u0,gjxPF`&]*?p;N}:+]OtuݚuI!gtӓʢr3lqei$vmcf_`㊵rtO@CjoiAqp^VkzhFu j>ycHu)h`wWFo\brRwvkd~7wpuHn- cD m;+^%M`֍ݎl~ihw9t/UHokcށmTbH4 Or%o{oYcǬf=biQm6umtlJ!qb.};!_Qԍg䌁ɣ#hU-*UU [Teł+}OECy =o=j8 2Hb[:1$ a@&O$eD~4-ƖTk h!]zv n. dcog8#I\nQa'q#mtmnLSDX 2NIھE6cMW>V Q+4AK5C!B--K".&ف:A<h]|82Guju0ZM^<4Sw Frn{BZLdi-?oUF-T#RMҺ8{S p} VJXixrI.}bL7Op-ILRIiL_ nLa𚍸 M~#Be ‚yf(03TxV; VD9 ` rhewF,".J){v g\׉" -r2tsvu$vrIlbe'xAV3rԸٷ ׺o_0 TP@st,_ of UDMe"T"7/Bca1KӜ MSV.. DfK FTu t f'm[I$J} HS)aWJM4%1ο^ 0fKg7 L4Z~LL { eefte 0 3On1 _ӳB&lB캏 +C<}idCgE!>PKA< W{b>-`<eLoo`  U 0mi ]&JOZSf s #d#bJQ$KkAWsgT4HAW5R?⏫G~DlL]K(IQKM"j᪪J_D~RHVhY^v^R)V۠!ER@bERIL v{[A_O RA#$IٻFOTңG_N϶$ nM <{U{OEJqSPo@pU۠)D\ʠK3AO!WYC+,`/!&!~ ꕘ ΍NܺUT^URՙ$TgHy}"I@%q0=EL_BAESK@*6}߶ brU6W`l?7~o ;A%W2~&W7 7*4#ז1w6l`;{d ܋s7DPű:>GAvNjB VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170xing not found D 1+ +  + S|hS@+   y   ,,|S@+   y   ,, (T &(J=\ H  0=E  $= !="# $$='E '(()=*Q]*d *+Q+,),-H -40"01 2,4" 466 8::=<E  <==,>=?@P AC=DHI8J3J K8 L4MN O R3RS=TUPV:W9X=Y3Y [J \]6la^EE%copy_text(str(vte$x_match_!AS, '^M'))2No pattern matching the replacement argument ^E!SL^M"No string selected for replacement+5S  )  6 0+S+  $J/  !!""##Y# #8$=%8&3&(= )*00t1122T3 3 444(6'l77 8: :;== = >J/ C C@DS,E"E6 Gd(HTH H4I"I6 JK6OP3PP  PQ3Q UNo target to replace...replacing...Replaced !SL occurrence!%SCould not find: !ASString not found<,+   6  J/yA Y 8=83= !!""T# # $$$(&'l'' (* *+=0J/ 1 142"26 3d(4T4 445"56 676;<3P<  <=3= ANo target to replace...replacing...Replaced !SL occurrence!%SCould not find: !ASString not found   ^ t K L3= =mK3 L3 =!" %%\% %8&&=(E ())*=+R+, ,-%.@%1P%3X&@ '@H @.P/ .<1 1(3Q3434556=7 7L88\9 9(: ;<8? 3hAH A@C"C6D EFF= IL=M'P Replace by:^M^EE^EQ^EE^M:No pattern matching the replacement argument !AS - Ignoredh 0V ht 0V \ $  x\ T&T   ( T    83 KPP  8 8 hKPY   !"6  $%,#Function not allowed in this window3\ 83P 5W V 3  \  8W\ $ ||&(J J  |&(J J  |"R R Rm  Rn   !%DD LS+ /  / S,)"X)Q  "/ 4d "+ tQ+ L"t+ 6H+S / Character: !UW!OL!XL$Illegal radix - must be 8, 10, or 16@ ` ^8 t  K   S+Text:\"<R!%T( T$ $  ] 6  No more filest 4<   Character: \PPA   h  \ ; + KP &c1 ljxf VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170]"+1 ,1+ (s1 "D#+ #,$<%+&S ' (7-H\T " 6 =  L^8K \6 #S !"$ "&S')*(3()Jc*=+,K(-..Up11 2P46$677@8Pp9T9 l:: ;= =>P? BB=C:D8EJcJ$ JL+MSOKPQ=UDon't understand file name: !AS(Wildcard) Filespec [*.*]:*.*; Directory listing of:   -- No such files --@+S\; \ 0++S  + N5 O  pL0Xu  L8  Enter Space @&(J 4J    TK  Z H 4%2p%(|%%% %%&'    l Tl <V $@   Character: AOUaousAz 4S+8 A  L ^8 h K 6, S+R] p  %&s&' ' (6|).O/01K 226Formatter name (file type):..+Sorry, don't know how to format this bufferH| 2   .08 t42  &F l 2  l 2 y  =| PS0+S +  5    < PS0+S +  5    >`8P83 Q  8  5 Q8 3=u2=3S 8  DTRCOB --\Q<8 5   DTR+<@8P83 Q  8    3 =u1( A Dj 2=  =  Q8 3=u !2"=#3##S# #$8 &',FOR**COB **SX +    S+ yX (J  KL4  lastlast@@@tz   6 OSX+ O OS+ yOOXO pO  23"Z#O$3&K '',No formatter selectedchange0(S+L 0S+L SX +    S+ yX (P  QL  lastlast@@@l`S@+ U U y U UUЩU S`+ (J  J p  &(T  (  J   JK TJK  THJK  $Sp+ 0Jc (Jc x  & 0  Jc (  JcK \ȦJcK  \hJcK      0+S+  Y 8=83!="3" #$))&()**J+,1 1223 3(4l55778 ,9:  ;x<3< <== >D??@ ,AB F3FGH8I3I IJ J|K3K K\L=M3M MN8 OP= QU3UUV X=Z ZP[\3\ \gG] VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170 1]= ^d `Ta a0bucc de8 hjjJmPl   P   PĠ  , $p&)&/,8\8 T  &* "<   7Modifications will be lost ... Delete buffer !AS anywayH  0 + S+ 3u83t  0 + S+ 83y83&(T JL\ 18J $ 3 3\  8 3   ,3\ 83   3   l1 |3=v 8 3     3  S   83y830ę4   &(  , 8 $ h 8  $!"#*XD++\+ +D,3,  ,-= / 12 2 82 233Y3 43Y4 84 4,5X667:  ;= < =(>X?6BH3PH  H,IJJ TK8L3LM8O9PQ8R3RSR RLST8UPU UV8 XY8[3[]=^_3_a=b8f f 8f flg=hi  ijPk:l9m= no r s tJ vz z 8z z{3{{\{ {D|8}3}~8 33P O A =P:  9LL= 6  3  6Unerase PlaceholderErase Placeholder /NoGotoUnexpand)Cursor was moved away from restore regionNothing to restore (Cursor was moved away from restore rangeNothing to restoreX DJ@K J*"6K,J/ .J@K$&#h! ""#&)$&/,$8$$$\$8$ $&''(+J/V,V-J/ .A.BA. .H/o//B030&0A23J 566S6 6 7J 8@9A9B89 9;69@&@CCD&)E&/,E8EFF\F8F F$G&*HR.HJ"J JKLL4N"oN6 OPPJ/qQVRJ/ UJ W<XXSX XYJ\&3\ ]aK(b&#0bhJ@i.j9jk5kK khlJ*m3mn=o pUq=s v)Will not exit; could not write buffer !AS ...exitingLBuffer was not changed or has been written already - Position not rememberedWrite buffer !ASABuffer !AS not written - There is a higher version of this buffer ...exitingtH@"86    L^8K 6 S  h!"""=#8$3$%8**+ +,/ /40"06 1`2?3,444= 5 6=78<Don't understand file name: !ASFile to append:Could not append file: !AS`  L^8K 6, !(q!!(W"A" "$#3|#$=%'&'))*&**l+m++,;,) ,- .P0&30 1\24&G45 5466=77 89 9:KP; <<==> >? A,B6oC=D F,G=H6IIMQQR&RS SXXT T<UK$VV WX= [(\\_K(`` ab d)*g Buffer name:*% Ambiguous buffer nameNo such bufferX4"h6  &. VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170@)  &/, 8  &@, 8     \ 8   lJ/}VJ/  Could not write file !AS ...writing...H@",6    L^8K 6 3S 0 3  !H"#8$3$%8**+ +,/ /40"06 1`2?3,444= 5 6=78<Don't understand file name: !ASFile to include:Could not include file: !AS )*3Jc=K(U P&!!"&*"# #Ll${m$$%;%)% &')&V,)5) )L*+P-&G-"- . 0&/ 01 2\3&) 34| 5,6&67UO< <<= =l>*>l@@C CD H&3H IJ KPN&NPP@Q&*QR RLlSYmSST;T)T UVX&V5X XtYZP\&G\"\ O] ]^ a&3a bdJceKfDgg=h:i8 jdk6lm=nnoo qrs=w" Buffer Lines  !24AS !7UL read-onlymodifiedconstant, current  !24AS!8UL System , currentNo such buffery4S+8 p L ^8  K 6, Input filename:xxS8+ r  s @  &/  r  s,x&@ @+S+A  6\  J K   AVTEDIT was started in read-only mode - buffer will not be writtenP,w&)&/,8&G8 H+S+A ( d  JK =Modifications will be lost ... Set buffer to read-only anywayu ^&: 0  &* H #  30124 "K   d&: (&* ## #$%)Output filename [!AS]:sH@"L6   L ^8K  V = 3 !!Y!  !"8$'Don't understand file name: !ASOutput filename:rK )   J%789u =*Ux(qK 6( X &L 7&K8&J9) J%u "$Function not supported in batch mode8oK 6Sp +  y+ @ +  z 6} H&XT {  |$Function not supported in batch modeRight margin must be positivepn P    y   8",q86( (JbK+* * H+*X+,8  , !"(P( ())&h)**+*8* *++ ,D- -.J<0J<+ 34P4 455&h5*6+*867&h8*88 89+ :D; ;<J<>J<+ ABB&hB*C+*8CD&hE*8E EF+ GDH HIJ<KJ<+OOS(currently set to !SL) .Right margin must be greater than left margin jK 6   )  J*u &&V& hJ"Jc,6 p!%&3% &0()) ) * +T--u..// 04$Function not supported in batch mode)Buffers cannot be changed in graphic modegK 6 )   J* u $Function not supported in batch modefK 6 )   J*u $Function not supported in batch modeHx?a VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170lOfS~  6    eK 6  &cx   XS0+S+ ~   LsJ% ,"6 !@""J%&$Function not supported in batch modeICursor line must not be greater than window length (currently set to !SL)c ,l   S  ST + l+ 1+o (&5&F <"q6 Xy"S#+2 $u%%2'2*-(currently set to !SL).Left margin must be smaller than right margin TaK 6   + ) >S  pJ%u  < !!&c!~#H"""#J%u$$%% &T 't))J%u**++ ,/S0+ 233&J3 34 5t77J%u8899 :?$Function not supported in batch mode(L^K 6 )   &cJ%u h$Function not supported in batch mode ]K 6 )   J%u $Function not supported in batch mode \ J$ K  6P  $++ J$>S X) p+)A)8  +QA  # #$> $%`&)(9l))** +, .D|2:2<u4G4<t4:4;6&ct6<6s8:;9&dw9o99:J%;J%?uAIB<oBC<CDDDEEJ%FFlGGHH IJ)K)L= N8OJ$P6QUS W,X) XY Z [^J$a$Function not supported in batch mode Split WindowToo many windows@W,WK 6  P S0 + S+  $Function not supported in batch modeHVK 6  P S0 + S+  1$Function not supported in batch mode\U 3P =uE   :81y&F##&5#s$v$$m$$%&=)@S=8  &W ( ]  , 6h J/^J/ -Non standard Tab setting - buffer not changed ...working...@R=8  &W ( ]  , 6h J/^J/ -Non standard Tab setting - buffer not changed ...working...DsEERE)EF+ F,lGGH IOJ+ JKuMMRNQ+nNoNsOoOORnOO P@ S0lTKTQ+nTT U W[[J) \l]+ ]41^+^^J) _(``J)cSd+ e(ffJ)j"Could not change Tabs as specified  !Unknown Tab setting - not changed  1xTL$64J) "Could not change Tabs as specifiedK$6p ,  J) (  J)"Could not change Tabs as specified K  3   Y ,83J/=E  dH=18 l= 8!J/ $ ...working... dI((    p ^\ K 6,  # Process name:@H L^8] VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170^K  6 K K=! DCL command:t$G8h06  O #DCL subprocess could not be created0 F,Ja&(J= X8381S 8 ! "8 #$(3(()3) **1*w*x**8+3+ +,=.3. ./3/ /0Q01:23 415R5(~5 56 @88 9:8 <X>=?@3@@D2E E1FFHH&FHlII%~M=NNN1SN N OPR=T3TT`UE  UVV$W=X Y[=\\\1S\ \ ]b=c=udE  de e@ff=gg gh8kk&5xkk l=un3nn\n nopP qrPsu w:x=uy3yy(z{P|2 }P`=:=u3  ==J #x? J$&(J 0+S+   3 $%=u&&(~& &'))&5x))*2 *1++-=0300S00128333345 7378E  89 9::=;=u<3< <$=== > ?=@=vCDD DEPF8uIIJJ$K3K L P3PP\P PQ8RR1R8STT TU V WY2YxYY8 \`_=u`E  `ab bcc=d8ee&5xeef2 f1ggi8jnn\o3ooSoo,p8rr1rrs tuvv1vw8xy {|| |T}P~818l JJ$  8 4L j ~ ~  Character: D8~ ,()[]<>{}+-*!=:/.;$_'"$7 ~$7~|7  L^8K 6, #&  #K$J$&3|&'')$ )*$Y* *8+=,-?- .p/C/61l22=535S5 56=7KX889J$:: ;< >l ?LBM BqBsoBTCE CD DEEF FG=HKIJ$KK4LKf LMUO3|OPPQKRJ$W=X: Y\ Filename:.VTEUsing previous command file !0h3 0433 J@  @ J@  J@4d2,J@    + +S]J@]4u "J@&,1K 6 [H 0 $[6$ 8S+  S +"]$$%]4u&&'' (+$Function not supported in batch mode-Recursive learn sequence - Learning cancelledmessage('Nothing learned'), 2p/@X8 $ 6  K 6[@0$[6 8/ [6#message('Nothing learned'), 2Learning aborted$Function not supported in batch mode+Learning finished - use X to execute Learning...-J-J-J-Jl-fL-f,- J@   ^  K L3= =K X3=  =%&(%&J'J@()J@*+J0K1P1 1t2J' 44&*4"54J'"9 TPU command: !AS buffer *K  ,'  $'u = 8e VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170Uam!!"  #*$J' %J'" &6 ') )*J*+  ,J*-`. /0 2,39 4 6 ; < < =8? ?@ QEBQEBAEQEBAE EF FHHQI I( IAJ JZN NQ" Q kQQRRRS QXn XTY1YRYZ*  \Q_ Q_ A_ _Q` 5` `Tb1bRbc  d$e   g`Qh 5h h(id  j kI  or=sw  x ) yPzP{  |t|+}}+I}+n}M} } ~ t++I+nM  PP&|l| , 1t*M  PP}q =uE  =< P \ Dt++I+nM 33 , =vPP =U U 2. Q Q  $J*"  tp |`  ```,% $ $   da, $ J* x Q AQ BQ CAQ DAQ ?A8 x=2 J*U=U J*  <R ]h Z  I  =&FY*  vte_helpvte_help Help buffervte_vt100_keypadvte_helpvte_helpMPress Return for more, "?" for a list, Space to exit, or any key or command: ?5ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz@?+Enter name of command you want help on: !AStputpuhelplsevtelselsehelpcommandsvte_helplanvte_helpvte_help GENERAL INFORMATIONMatch control characters Numeric argument Prompting //  space returnvte_vt100_keypadvte_helpvte_vte_keypadvte_helpvte_lse_keypadvte_helpvte_vt200_keypadvte_helpvte_command_listvte_helpvte_lse_key_listvte_help vte_lse_listvte_help next_screen previous_screen move_down move_upunknown typingvte_helpL E S 4,6   &,  &@A  6&&G&V,8  6J&3 p!+!"'J@(*)J@* ++, ,,-"-61&Editing session is not being journaled&Editing session is not being journaled4You have non-empty user buffers - Journal not closed;Are you really sure that you want to close the journal fileNow writing journal file !AS44,6    + >S < $J   J  pS +!o!!B"3"&"A#i %T((T( () *(+,6[ 2 35S6+9&Editing session is not being journaled(No position remembered from previous run  K &a  &a &FY*   L^8K !"%6,& &'**+,Kx--.*/J' 0J'"16 6#7j8$8p::(:; ;<R<=9>1t>>+?? 8? ?@"DtXp0H`x$ FhFK GPGK- H8HKR I IKP JJK  KKK# LLK> MMK; NNK= PP QxQ R`R SHS T0Tu UU U$pWfW XY6\ [[K \\K ]] ]$p^&^ _`6 cL+c>cK cdf"fiK jk=lo&ao4p pq6osuU|V|}2.}Q~cQ~dAQeAQ`A \=2 U=U =&FY* 1Keyword (Buffers|Screen|Summary|Windows) or name: Show buffer Show Alias *Show Language *Show Package * Show ModuleShow Parameter *Show Placeholder * /Language=No informationShow Routine *Show Token * /Language=No information show(!AS)No informationLPress "Up", "Down", "Prev/Next Screen", or any other key to resume editing: next_screen previous_screen move_down move_up| J$J@J/  Th $6M VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170m| 6 !3!">"S#A# #($$ %|&  &\)  )* + +, .//33S3 3 465::&) :(;T; ;,=X= >P@@&*@"M@@BC(I(TIJ(AJ J8K6L%L(QJ/RSUJ@VVVW WDlY lXY"Y Z[ ^"_H(cJ$(dTd dee=fff1f fg hikl=mm mLn8o3op8qP rs uvvy?yzJ@(|T| |X} }(~=8=88J$J/ #DCL subprocess could not be created3Could not read or write temporary files for sortingNothing to sort8Modifications may be lost ... Sort selected range anyway4Modifications may be lost ... Sort buffer !AS anyway"Creating subprocess for sorting... $ set noon ...sorting...SYS$SCRATCH:VTE$SORT_IN.TMPSYS$SCRATCH:VTE$SORT_OUT.TMP /KEY=(POSITION:!SL,SIZE:!SL)SORT!AS !AS !AS  X S0 + + S 6  T ,( 0"q 6]"Need numeric argument"Type a letter to select a registervte$register_!AS := !SLInvalid register name$ 3  S  6@ 3=3=v3L3Qn3&";68 = 3  L!!3!!Qn!!"3"&""W"6$='You are at the End of Buffer [!6SL]!AS [!6SL]!AS\&G  3  \  3 & H  o    "t 6 ,"^6 6a!You are on line !SL of !SL (!SL%)2You are at the End of Buffer. The last line is !SLThe buffer is empty(< T $!"$!6#'. ',(. ()6#*.&(T.# ./ 014+55&,56&#,6A686 67K9&# 94:`;<JKBKPC5 CG&#cGH&#0HIJ* JK*N{" N OP= uSSS(TPlUU VuXXX Y Z= _`JaabJQc&dcd&bdsfsefi! ijjkJ?lm&dmn&bnspxpsoxopq sXtKLu, uvvyKDz{J2|J<K =~x:\:~x M6  :~x M R :~x M "RR RmRn :`|~x M 83 8 Q t~x MG 83 8 3 "R)K R)n% %%%(%)%*%S%T%U%s%x%y%z%%%%D%8%,%@&T'H <9< 4=@ BE B? @JJA6 6 JA \ <      =~:83 8  : 3 U J$JJJAJJrN 2       j R : ! JcJc    k U JQ(' J2 (   K4uJ!uJ! )Е VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170J/?JABK,uJ< u"""#J<~$x$~$x$%J%u**:~+:+;s-:;-</&#cx///>l0>0 02d3:34<4l5<6;68J<9J<:J<;J%<J%=J% ><??@@AABDEFuJ;J=~KK= K~LL=lN<O=OQJ<RJ%SJ' UJ'"W#[4u\\\^J<_J?aHbJ' cJ'"?iD jk&kl l$m&mo&op(pp(pAqq(qAq q r$`r t$u&ux xy<z&(  z{{ }~~  6 0#  #KJ$ ` 46&KU    #  2x#  4x#  301mm#  5n&i,8 X8 <p 6KU   ` ,   #  4#  2m#  30124Kx = $~x :&@ X "O  s dOw 4:"  ?@A $:  U & ` 0       &9   J &@  J &: #  24#  (J (J"&"&@#&,#8#A# # $Jc)** +d,  ,-JQ.J(/J1J  56;K<J/ = > ? @=AB CGG=HH&yIKLJ&#hvK'KJ L$MJ*OJ /PR\S6 ST6T8T T UWZ&Z Z$[&[?]&] ]$^&^@a?a@Aa atb? buc?c:e@ euf@f8h3hm& mn$ no& op p0r$_cr s$t$HLtz {+&8 p& $$ .Ki&Don't understand output file name: !ASInitialization already doneLSE $Initialize$Prompts $Messages Language Sensitive  !%D For help press "Help" key For help type " H"!%TAre you crazy?It's after midnight.Esta muy loco?You should be in bed.The early birdonly gets worms.Go away.It's time for lunch.Ding-a-ling-a-ling...This terminal is alarmed!I am very tired.Please let me sleep.It's almost midnight...$VTEDIT$DCL$TPU$Search$Target$Restore$Replace$Memory $Init$File$ $Local$Ini$ $Directory$Buffers$Help$Show$Paste $Matches$ $Choices$ $Commandseve$command_map_listfirstlse$cmd_key_map_listfirst $Recall$Line$$Prompt ...working...E Position to a choice and press Select or Enter, or abort with Ctrl/Z Show bufferEditing*%...sys$disk:[]*.*; current_file Re-editing LSE$SOURCE LSE$SOURCEsys$disk:[]*.*;sys$disk:[]*.*;No file selected - exiting**Input file does not exist: $Main. Inspecting!AS File "!AS"Using !AS FormatterFinding remembered position... sys$disk:[] $Defaults [End of File] LSE$SOURCECMS$LIB [], CMS$LIBSet Source [], CMS$LIB VTE$COMMAND.TPU VTE$COMMAND.TPUVTE$INIT.VTExdP<(\8T D(j'DN$LPPXx V(PTVTE$MAP_MATCH$"$'$x($D<$[${$\8T D2s'DN$LPRX| v(PTVTE$MAP_FLASH$"$P'$)$>$]$}$L8 T, VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170H4Pd'H4<TD`xVZ\ t <DxLhxz|VTE$MAP_INDENT$H indent_continuationG increase_indent`F decrease_indent(B indent:D indent_lessC reset_indent`E indent_more8?T@&j&'Pl|   (DPXt,-$@P5Xt?u$@PXt   < P X t       < H P l |       8 H P l |       < L T p       < L T p     <LTp $%(&0L`(h*19(:0T\;d>@BD8DLh|VTE$MAP_STANDARDj append_file_ delete_bufferp execute_register4 show sort9 return countt what_line@x display_control set_scrolli exit tpuxn list_buffers@m include_file two_windows other_window one_windowh attach8 dcl  set_left_margin spawn menut shift_right@ shift_left  find* substituteu write_ranget this_file@( replace) replace_all' exchange toggle_marktU set_mode@ find_next  find_marko read_filet write_filepk buffer@@ formatter ; file_searchؿl close_file findt find_mark@* substitute  insert_markؾ remove_mark select_rectangularh next_buffer4n list_buffers other_windowĽ change_windowsi exit\ show, show  doȼ tpu attachl dcl@ spawn compile mouse_position mouse_selectp mouse_paste 8mT &q &'  $ @ T \ x     8 H P l |       < P X t      < P X  $  % ( 8 (@ \ p )x * + .,8/@\l4t89: (8;@\l@tAEW,DYLhx[]a4c<`xegi,DkLpmoq<Ts\y} (<D`px8DLh| <LTp(0Llt (DPXt$,HX`| $@PXt8LTp (DT\x(0LX`|  $.,HX/`|024,84P\:d  VTE$MAP_BASICTc erase_previous_wordbgWGQi # CoXl.;;t0Lj>_O *h e(yv>F. [cT T4QX!2 2=F~ , *)̼/SLPk28$GW_.\MTG%; +} (eFpL0:A؊9| ' F vEm @l`hD߂&.H4-""]phucdds]Gnn7Z`=O&_wfc_he#Cj` ͅdsidb(ߑs dA#2!HK9NPaA7L.de5VbijSlum .߁iӛ+`Atn9wd+gE'_le<Om+q ]&&Cw!@ 9  fq}  v __ X$TM. hW1q32W W?aYjl~ )_Y@zn|tbr@f&cˑlČ&?S Hƚj'6fǜcudAYQ\H 8R(TE =L+s.!ki6aܞIoW"ew8a3>%eG;KL{ǝrBcx!o^d*nn,paoLn:xag[iy(aa)z㚰Cfąvra1gteuC(Hc;A2dfyoVc%e=c, lҼ:;ONT!sh;?`; X# !0ݓ(FDž+Q2;==t 5YrB;.cGx*oM?[<2*W80X)D!/vDCN Tt@r.A&m}lx;eZ < O ,s a2&> U{lG V ndc 0u{v ~cjt}\r.$nLknM.8CE eoNt P==Xlm#HWWNHb$0|AOCT6o`tB)K)졩mEz3'Zka]HF*vpnt֫>s߱#6JY{ޅQvg)vd6]DG(?T 0X<25IdbDE:vq/wo$iy 0gz )&s͍n,EW+2;g sDp LSD1M lcctp1]3.q V"fd HV@jE d 9TG[0AHB3m sBU[A5o@  Ro''\ tus0n #QԄTGޔ"6S(v  jY7sq%SNJ|lgfl$䆄A-:-"Rr#x!B (!8vhX~u!go.mtd -ngSt]$Fg jsnpgKi1,eb`WMBarIecL!I1C_|u=;i: Vsn`Z ѐRK5KvXf)'an$omzPuSnum9`5Kv{>~,`甐 ~wn@P7 YE~a_ hVV`JXc dwgAQe^A6{"MR^@ Ƽ!RZ:LkŋaUMYpv; ]R {|B_dmsxh'dƹ9+ dnr=um^aFeGn-8ASc"0=vjoV2DpU aqvc~fdet`_/1_[qesgeՔd*^efs?e V]t&Ś&$ZjET)ESO&NSJY{?!` z Ȋ(ν< ] f"G?BEIMl:T7[UI`3eeUtS_x Pe%)O N=! S,VUD8_g7dWzh$g1+Q\G _4C oRevq_9ekpclVvejsL!OŹB" ~ !F "/ +&q$  ;PETb}!mPUNi _8BSEc`kST%V# Y?D ^ wkEYN$15#ڝfc}g>ZvUf<ɧg}~B1)xeG}f-Tŝ㾖k{ad՚ldД|awlK'dDo\nH%Y!ML`ouh'QNsT60len>UM0dR!3u!~oi$us.sRi -nb5md1mR MaiF^6 ~.X2sƟiu~t3**D#/ ב)RQ'ˬn2hs4qn_f kwsD T, p>wc_b>k^Ekqs+ۓhom }f(nO! oEE{`ĨBs_oX"ar9nkudbOOM7wc*>s<ka=`D_> sIeuQoT r։ʵ(+Mize jSKQ̍Ss`7cgiq6!>Ay5 ,7H:f0~-NJc5'<gdsml, `q*l~mX|1A1?{OdKV5 t9;shagp#""H!Hw@dllwbgE/nn0/m`IUc S?JSo updedlL_>p蒷u!eFfSv@` d*f*rtcn#u`lv!8aDf_߶BDl狄Tܭm)ar ăOllf3f J<{lzjCrjTtg nf!y3j||sxo'};ku/u4viOE;<ݺVO 3K<-^;og8an:Gq$׻pe;,M}6—u( e{/^h D!s {dmd2u=52\;Ai!-~章dJCy#cˍ!Ƙt"grm/Gc!Cwy-sum vF`@1_ OX @Z{jAIdlc ;mupX!JF(qŋ0 LpG{cV6xR EH'$ an II=/d=;«~2p()U$Wm~/h}.Ccdt.aIw3_FWR laAVP ]1XKWZv *)"V,J$0 o v㷱=/cW1 HJD ۭE dK  'CA0q+I?,}B,7}+uNE`1YF j'R__kKBBi@IR G0rUOe,jߪ`te-`+9>tb ufz)`pn5۔:nox: ̤]7m x:Ck}IqncbarDnhF9Մ#jޔXZӐ>aАxfic_ V:~; > "RP '!mf6kXMV=\N;F IC;Ȳwn,(u~re/.pcBinjeot||pvR6c(zIM{{pn^6i}kbsun)cs &gpvf<u YxmTt*>2`7L[feJak]Xg5/w5~)  OU xCzd< u!yIr: ܻa蝳HvleőeFxdyvsye79 O(5 |94,Mhu%/JRO罪1R˪; %q8/Sq2!"l#!T cv{Y>RcuC1ܐ?F7x g(Nݍl8l Ad9 tab compress_spaces2 line_feedf remove1 form_feedL return trim_trailing, ^N count0 save_registerh  previous_word0O set_match- cut_registerĭX set_modifye erase_start_of_lineT,} refreshq set_writeȬ quit4 insert_numeric`8 quote03 insert_date6 insert_timeȫ= space expand_tabsd? umlaut 4 numeric_argument execute_tpu  numeric_argumentx compile_tpu D numeric_argument  numeric_argument  numeric_argument x numeric_argument 4 numeric_argument  numeric_argument  numeric_argument h numeric_argument $ numeric_argument   numeric_argumentv bound_cursordw free_cursor0L set_formatter set_journalĦ! set_search_case help\$ set_search_origin  learn get_next_word center_line fillT[ capitalize_word set_tabs set_word_delimiters store_numbert] lowercase@^ uppercase  execute_learned_sequenceȣ\ change_case  numeric_argumentPa erase_previous_char move_up  previous_screen move_downx  next_screenD move_right move_leftܡ find/ save| pasteLR set_case find_next next_line scroll_up| topP bottom  start_of_line previous_line scroll_down|` erase_next_charDg restore skip_range: split_line  next_pagex markH select_rectangular  findܝf remove select|  previous_screenD  next_screen compile_tpuܜ execute_tpu end_of_linet2 line_feed@ previous_page help؛ do mouse_operationL`8T TTPU$KEY_MAPUp PA VTE$LIST_NIL$<-VTE$MAP_STANDARDVTE$MAP_BASICUp PA  VTE$LIST_MAR$d-VTE$MAP_STANDARDVTE$MAP_FLASHVTE$MAP_BASICUp PA  VTE$LIST_FOR$t-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_FLASHVTE$MAP_BASICUp PA VTE$LIST_DOC$|-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_BASICUp PA   VTE$LIST_ALL$-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_FLASHVTE$MAP_MATCHVTE$MAP_BASICUp xPA VTE$LIST_CMDVTE$MAP_BASICUpPA  TPU$KEY_MAP_LISTVTE$MAP_STANDARDVTE$MAP_BASICTPU$KEY_MAP OU VTEDIT051.B)2[WECK.VTEDIT.KIT.V51.B]VTE_SECTION.TPU$SECTION;170FC VTE_SECTIONVTEDIT V5.1-03726-SEP-1989 10:0626-SEP-1989 10:06VAXTPU V2.2 1988-12-17 14:03 .$$ABS$$.TPU$$K_SECTION_BASE#*[WECK.VTEDIT.KIT.V51.B]VTINI.TPU;23+, ./ 4P2-)0123KPWO56Zǵ7F89GHJ procedure tpu$local_initF! Set up different defaults at startup. To activate one or more of theF! following alternate defaults, remove the exclamation mark before the$! corresponding VAXTPU statement(s).?!vte$x_word_separators := ! Set word separators to extended set.! vte$x_init_word_sep + vte$x_add_word_sep;5!vte$x_flashing := 0; ! Disable parenthesis flashing?!vte$x_matching := 1; ! Enable automatic parenthesis insertion*!vte$x_search_case := 1; ! Exact searches<!vte$x_search_origin := 0; ! Jump to top on failing searchesH!vte$x_hot_zone_size := 8; ! Wrap words before reaching the right margin4!vte$x_free_cursor := 1; ! Use free cursor movement<!vte$x_do_vte := 0; ! For LSE support, use Do to invoke LSEF! Options to influence the style of Fortran code according to personal! preferences or company rulesG!vte$x_indent_comments := 0; ! Don't indent comment lines automatically?!vte$x_indent_cont := 0; ! Indent continuation lines like codeH!vte$x_fortran_basis := 8; ! Write Fortran code with Tab as the 1st charG!vte$x_continuation_char := '1'; ! Use 1 for Fortran continuation field>!vte$x_auto_case_enable := 0; ! Disable automatic case controlC! Option to influence the style of Cobol code according to personal! preferences or company rulesE!vte$x_cobol_string := "'"; ! Use apostroph as Cobol string delimiterH! Option to influence the style of Structured Language code according to'! personal preferences or company rulesJ!vte$x_indent_struct := 2; ! Indent Structured Language in increments of 2F! Option to influence the style of indented code according to personal! preferences or company rulesG!vte$x_indent_spaces := 1; ! Use spaces instead of Tabs to indent linesK! Select a different DCL symbol name to contain the message to be output on! termination of the editorH!vte$x_final_message := "VTE_FINAL_MESSAGE"; ! Symbol containing messageH! Perform an automatic Goto Source Command after each Previous/Next Step9! command in REVIEW mode of the Language Sensitive EditorF!vte$x_auto_goto_source := 1; ! Add a Goto Source after Prev/Next StepP! If any of the lines above has been activated, activate the following line, tooG!vte$update_status_lines(1); ! Show the new defaults in the status line endprocedure;tpu$local_init;rmhS epj%116=7 >  tab blmpress_spaces#*[WECK.NTEDIT.Kҩ41,BoVRIHI,TZU;2niEe^dceH ./Pf2 remove-)1123 foro_-ePWO5I7`Zµ 0frf8!FN J trim_trailing ,pr͙vpg pp$bo`_inhtG! Uev w.ndoffeRNefaults at stajtup. ToϟhvctU inc mr.morESE+!iRTllowing alternyte defaˆ- pegope&tje.excLS2Dbefore the$! {orrespo^ʕf TATVU&sva~emeNMvCat\h!vte$x_word_seharatorsܗ QeY qotd"shparA,RI nded set.! 8vte$x_iĈvopdscp&+"ve$x 9 ep;5!vte$x_ftashing : !EDosgbne4parE  6T,1 iQe!vte$x_matchqng := 1o!Elal` guvomatic parenthesik insertE’+#v e"xYsgazch_CR_NH1; ! Exact kearches݉ue&x.scatcj_erigIENbWBR}D Jump to top ov failin`rahsM'vve!x_hO*ne_size := 8; !8Wrap woȏcedoFe&rcaahfng T S7U n4!vte$x_fre}_cursor@0;  Ssc drce cUEmovement<!vteT:= 1; ! Use spaCes instAɘlg"Tbv uoݖfdenr nies n>mDR:3U E fferent DCL symBol nameӓ`nltik uhdessggg eo bENgnmDNermination of tpe editoI#ve"xYfknll_mE YHRQ9&E_FINAL_MESSAGE:; ! SymȐboltihihg"missaGre-_BU"orm an automytic Got_traelCimkald.aftEE>R= us/Next Step99 comman!RGVEQ kofe,of TT  Sensitive E|itor݉ue&x~asti_eodo_sO:S_\RRSVBA2d a Goto Soujce aftedv-Nxr UtgpPH, Pany of the linek above 4Ǐcegnaetovctwd, A)R:O wing line, tooG!vteӌ`tg_tgtss]lones]LZ{O Show the new |efaults̒uhg tgtss"lgne ght:0 re;tpu$lo{al_init center_line fillT[ capitalize_word set_tabs( set_word_delimiters store_numbert] lowercase@^ uppercase  execute_learned_sequenceȣ\ change_case  numeric_argumentPa erase_previous_char move_up  previous_screen move_downx  next_screenD move_right move_leftܡ find/ save| pasteLR set_case find_next next_line scroll_up| topP bottom  start_of_line previous_line scroll_down|` erase_next_charDg restore skip_range: split_line  next_pagex markH select_rectangular  findܝf remove select|  previous_screenD  next_screen compile_tpuܜ execute_tpu end_of_linet2 line_feed@ previous_page help؛ do mouse_operationL`8T TTPU$KEY_MAPUp PA VTE$LIST_NIL$<-VTE$MAP_STANDARDVTE$MAP_BASICUp PA  VTE$LIST_MAR$d-VTE$MAP_STANDARDVTE$MAP_FLASHVTE$MAP_BASICUp PA  VTE$LIST_FOR$t-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_FLASHVTE$MAP_BASICUp PA VTE$LIST_DOC$|-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_BASICUp PA   VTE$LIST_ALL$-VTE$MAP_STANDARDVTE$MAP_INDENTVTE$MAP_FLASHVTE$MAP_MATCHVTE$MAP_BASICUp xPA VTE$LIST_CMDVTE$MAP_BASICUpPA  TPU$KEY_MAP_LISTVTE$MAP_STANDARDVTE$MAP_BASICTPU$KEY_MAP