Trailing-Edge
-
PDP-10 Archives
-
bb-r775c-bm_tops20_ks_upd_3
-
sources/lset.bli
There are 10 other files named lset.bli in the archive. Click here to see a list.
%TITLE 'LSET - SET line-mode command'
MODULE LSET ( ! SET line-mode command
IDENT = '3-012' ! File: LSET.B36 Edit: CJG3012
) =
BEGIN
!
! COPYRIGHT (c) 1981, 1985 BY
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
! ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
! INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
! COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
! OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
! TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!
!++
! FACILITY: EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
! This module executes the line mode SET command.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: February 3, 1978
!
! MODIFIED BY:
!
! 1-001 - Original. DJS 28-JAN-1981. This module was created by
! extracting the routine EDT$$SET_CMD from the module EXEC.BLI.
! 1-002 - Regularize headers. JBS 20-Mar-1981
! 1-003 - Use the ASSERT macro. JBS 01-Jun-1981
! 1-004 - Implement virtual memory deallocation TMV 6-Aug-81
! 1-005 - Use the new message codes. JBS 06-Aug-1981
! 1-006 - Add set command for repeat/norepeat. STS 26-Aug-1981
! 1-007 - Add set command for fnf/nofnf TMV 10-Sept-1981
! 1-008 - Correct SET SEARCH command. JBS 29-Sep-1981
! 1-009 - Add SET [NO]SUMMARY command, the SET SEARCH WPS command and put
! in a stub for SET PROMPT. STS 01-Oct-1981
! 1-010 - Set up proper search routine with set search WPS. STS 02-Oct-1981
! 1-011 - Add set up of text for page and end. STS 06-Oct-1981
! 1-012 - Don't allow escape or control chars for set text string . STS 20-Oct-1981
! 1-013 - Don't allow characters with ascii rep > delete either. STS 20-Oct-1981
! 1-014 - Implement SET PROMPT. JBS 21-Oct-1981
! 1-015 - Add set word and Set para. STS 22-Oct-1981
! 1-016 - Add four more prompts and increase their lengths. JBS 23-Oct-1981
! 1-017 - Remove check to see if we have the original strings when allocating
! memory for text and entity strings. STS 06-Nov-1981
! 1-018 - Add setting and clearing of ENB_AUTRPT. JBS 10-Feb-1982
! 1-019 - Add more range checking. JBS 10-Feb-1982
! 1-020 - Correct range checks -- MAX and MIN confusion. JBS 13-Feb-1982
! 1-021 - Perform aux keypad enable/disable on SET [NO]KEYPAD. SMB 23-Feb-1982
! 1-022 - Only enable/disable numeric keypad if an EXT command. SMB 26-Feb-1982
! 1-023 - Add range checks to some SET commands. JBS 10-Mar-1982
! 1-024 - Correct the reversed test is SET CURSOR. JBS 11-Mar-1982
! 1-025 - Add SET COMMAND. JBS 04-May-1982
! 1-026 - Respond to error return from EDT$SET_HLPFNAM. JBS 04-May-1982
! 1-027 - Take out setting of HELP_SET. SMB 27-May-1982
! 1-028 - Call EDT$$SET_COMFNAM on SET COMMAND. JBS 07-Jun-1982
! 1-029 - Don't allow SET COMMAND with no argument. JBS 08-Jun-1982
! 1-030 - Remove prompt PRTC. STS 07-Jul-1982
! 1-031 - Force CR,LF into first 2 prompt character positions. SMB 15-Jul-1982
! 1-032 - Add new string search options. JBS 19-Jul-1982
! 1-033 - Call a routine to set screen width. SMB 29-Jul-1982
! 1-034 - Change the interface to EDT$$SET_COMFNAM. JBS 23-AUG-198e
! 1-035 - Add more SET TERM commands. JBS 02-Sep-1982
! 1-036 - Conditionalize screen changed settings. SMB 11-Sep-1982
! 1-037 - New screen update logic. JBS 13-Sep-1982
! 1-038 - Change SCR_CHGD to SCR_REBUILD in a few places. JBS 09-Oct-1982
! 1-039 - Repaint the screen if any terminal parameter is changed. JBS 01-Dec-1982
! 1-040 - Don't allow changing of terminal type from change mode. STS 13-Dec-1982
! 1-041 - Rebuild the screen data base on SET SCREEN. JBS 15-Dec-1982
! 1-042 - Remove unused reference to EDT$$ERA_MSGLN. JBS 20-Jan-1983
! 1-043 - Add conditionals for WPS and VT220 support. JBS 10-Feb-1983
! 3-001 - Fix various string ptrs and prompt string handling. Make this
! a 10/20 specific module. GB 28-Feb-1983
! 3-002 - Convert dispatch numbers to symbols to make the module easier to
! follow. CJG Ides of March, 1983
! 3-003 - Make other changes to make it work on TOPS-20. CJG 21 March 1983
! 3-004 - Add TRANS_CHAR to translate characters of the form <CR>. CJG 23-Mar-1983
! 3-005 - Change action of SET PROMPT so that <CR><LF> is not forced in. CJG 15-Jun-1983
! 3-006 - Change the way that filespecs are handled. CJG 23-Jun-1983
! 3-007 - Fix byte pointer in SET HELP. CJG 8-Jul-1983
! 3-008 - ADD SET [NO]CONTROL-T COMMAND. CJG 25-SEP-1983
! 3-009 - Fix incorrect allocation of space for SET TEXT/PROMPT/ENTITY. CJG 5-Oct-1983
! 3-010 - Add SET SEARCH [NO]IGNORE. CJG 2-Nov-1983
! 3-011 - Make sure that SET TEXT does not convert <FF> etc. CJG 8-Dec-1983
! 3-012 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
LIBRARY 'EDTSRC:SUPPORTS';
!
FORWARD ROUTINE
EDT$$SET_CMD : NOVALUE, ! Process the SET command
TRANS_CHAR; ! Translate caracters
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
REQUIRE 'SYS:JSYS';
REQUIRE 'EDTSRC:PARLITS';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
BIND
KEYPAD_MODE = UPLIT (%STRING (%CHAR (ASC_K_ESC), '=')),
NOKEYPAD_MODE = UPLIT (%STRING (%CHAR (ASC_K_ESC), '>'));
LITERAL
KEYPAD_MODE_LEN = 2,
NOKEYPAD_MODE_LEN = 2;
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$SET_CMD - SET line-mode command'
GLOBAL ROUTINE EDT$$SET_CMD ! SET line-mode command
: NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! Command processing routine for SET. The SET_TYPE field
! contains an index identifying the type of SET command;
! case on it and handle the particular command.
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! US_ENT
! US_TXT
! SCR_LNS
! EXE_CURCMD
!
! IMPLICIT OUTPUTS:
!
! NOS
! CAS_FLG
! EXCT_MATCH
! SEA_BEG
! SEA_BNDD
! TI_TYP
! VFY
! TRUN
! KPAD
! SCR_CHGD
! SCR_REBUILD
! WD_WRAP
! SCLL_BOT
! SCLL_TOP
! TI_WID
! EDIT_DFLTMOD
! SCR_LNS
! US_ENT
! US_TXT
! QUIET
! RPT
! FNF_MSGFLG
! TAB_SIZ
! TAB_LVL
! SUMRY
! ENB_AUTRPT
! PMT_LINE
! PMT_KPD
! PMT_NOKPD
! PMT_HCCHG
! PMT_INS
! PMT_INSN
! PMT_QUERY
! WRDTYP
! PARTYP
! CTRL_T
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$SC_SETWID,
EDT$$FMT_LIT,
EDT$$OUT_FMTBUF,
EDT$$FMT_MSG,
EDT$$SET_HLPFNAM,
EDT$$SET_COMFNAM, ! Set the command file name
EDT$$INT_CONTROL, ! Enable/disable ^T traps
EDT$$ALO_HEAP, ! Allocate heap storage
EDT$$DEA_HEAP : NOVALUE; ! Deallocate heap storage
EXTERNAL
EXT_MOD,
CAS_FLG,
TEMP_BUFFER,
EDIT_DFLTMOD,
FNF_MSGFLG,
US_ENT : VECTOR,
RPT,
US_TXT : VECTOR,
EXCT_MATCH,
IGN_LEN, ! Ignore length
IGN_PTR, ! Ignore pointer
KPAD,
NOS,
SEA_BEG,
SEA_BNDD,
SCR_CHGD, ! The screen has been mangled, it must be repainted from scratch
SCR_REBUILD, ! The text area of the screen must be rebuilt from the work file
SCR_LNS,
SCLL_BOT,
SCLL_TOP,
QUIET,
TAB_SIZ,
TAB_LVL,
TRUN,
TI_TYP,
TI_WID,
VFY,
CTRL_T, ! Set if CTRL/T available to EDT
WD_WRAP,
WRDTYP, ! flag indicating word with delimiter or not
PARTYP, ! flag indicating wps para or not
SUMRY, ! output summary on exit flag
ENB_AUTRPT, ! 1 = maniuplate auto-repeat on VT100, 0 = don't
TI_SCROLL, ! 1 = terminal has scrolling regions
%IF SUPPORT_VT220
%THEN
EIGHT_BIT, ! 1 = this is an eight-bit terminal
%FI
TI_EDIT, ! 1 = this terminal has editing features (ICM, DCH, IL, DL)
EXE_CURCMD : REF NODE_BLOCK, ! Pointer to the current command.
PMT_LINE : VECTOR [32], ! Counted ASCII string of line-mode prompt
PMT_KPD : VECTOR [32], ! Counted ASCII string of keypad prompt
PMT_NOKPD : VECTOR [32], ! Counted ASCII string of nokeypad prompt
PMT_HCCHG : VECTOR [32], ! Counted ASCII string of hard copy change mode prompt
PMT_INS : VECTOR [32], ! Counted ASCII string of line-mode insert prompt
PMT_INSN : VECTOR [32], ! Counted ASCII string of line-mode insert nonumbers prompt
PMT_QUERY : VECTOR [32]; ! Counted ASCII string of /QUERY prompt
MESSAGES ((INSMEM, INVSTR, NOSETTRM, NUMVALILL));
CASE .EXE_CURCMD [SET_TYPE] FROM SET_NUMB TO MAX_SET OF
SET
[SET_CASE] : ! Set case
CAS_FLG = .EXE_CURCMD [SET_VAL] - 1;
[SET_CTRLT] : ! Control-T
BEGIN
CTRL_T = 1;
EDT$$INT_CONTROL (3);
END;
[SET_NOCTLT] : ! No control-T
BEGIN
EDT$$INT_CONTROL (4);
CTRL_T = 0;
END;
[SET_CURSR] : ! Cursor
BEGIN
!+
! Set top and bottom margin, making sure neither exceeds the
! number of lines on the screen.
!-
IF ((.EXE_CURCMD [SET_VAL1] GEQU .SCR_LNS) OR !
(.EXE_CURCMD [SET_VAL] GEQU .SCR_LNS) OR !
(.EXE_CURCMD [SET_VAL1] GTR .EXE_CURCMD [SET_VAL]))
THEN
EDT$$FMT_MSG (EDT$_NUMVALILL)
ELSE
BEGIN
IF ((.SCLL_TOP NEQ .EXE_CURCMD [SET_VAL1]) OR
(.SCLL_BOT NEQ .EXE_CURCMD [SET_VAL]))
THEN
BEGIN
SCLL_TOP = .EXE_CURCMD [SET_VAL1];
SCLL_BOT = .EXE_CURCMD [SET_VAL];
SCR_REBUILD = 1;
END;
END;
END;
[SET_KEY] : ! Keypad
BEGIN
IF (((.TI_TYP EQL TERM_VT52) OR (.TI_TYP EQL TERM_VT100)) AND (.EXT_MOD))
THEN
BEGIN
EDT$$FMT_LIT (CH$PTR (KEYPAD_MODE), KEYPAD_MODE_LEN);
EDT$$OUT_FMTBUF ();
SCR_REBUILD = 1;
END;
KPAD = 1;
END;
[SET_NOKEY] : ! Nokeypad
BEGIN
IF (((.TI_TYP EQL TERM_VT52) OR (.TI_TYP EQL TERM_VT100)) AND (.EXT_MOD))
THEN
BEGIN
EDT$$FMT_LIT (CH$PTR (NOKEYPAD_MODE), NOKEYPAD_MODE_LEN);
EDT$$OUT_FMTBUF ();
SCR_REBUILD = 1;
END;
KPAD = 0;
END;
[SET_LINES] : ! Lines
BEGIN
IF (.EXE_CURCMD [SET_VAL] GTRU 22)
THEN
EDT$$FMT_MSG (EDT$_NUMVALILL)
ELSE
BEGIN
SCR_LNS = .EXE_CURCMD [SET_VAL];
!+
! Re-adjust the top and bottom lines if necessary.
!-
IF (.SCLL_TOP GEQ .SCR_LNS) THEN SCLL_TOP = .SCR_LNS - 1;
IF (.SCLL_BOT GEQ .SCR_LNS) THEN SCLL_BOT = .SCR_LNS - 1;
SCR_REBUILD = 1;
END;
END;
[SET_FNF] : ! Allow file_not_found_msg
FNF_MSGFLG = 1;
[SET_NOFNF] : ! Don't allow file_not_found_msg
FNF_MSGFLG = 0;
[SET_MODE] : ! Mode
EDIT_DFLTMOD = .EXE_CURCMD [SET_VAL] - 1;
[SET_NTITY] : ! Entity
BEGIN
LOCAL
LEN,
LEN_PRV,
ENT_NUM;
LEN = TRANS_CHAR (.EXE_CURCMD [AS_STR], .EXE_CURCMD [AS_LEN],
CH$PTR (TEMP_BUFFER,, BYTE_SIZE), 1);
ENT_NUM = .EXE_CURCMD [SET_VAL] - 1;
!+
! Get the length of the previous entity
!-
LEN_PRV = ..US_ENT [.ENT_NUM];
!+
! Allocate new memory if there is not enough space in the old area.
!-
IF (.LEN_PRV LSS .LEN)
THEN
BEGIN
EDT$$DEA_HEAP (%REF (.LEN_PRV + 5), US_ENT [.ENT_NUM]);
IF NOT EDT$$ALO_HEAP (%REF (.LEN + 5), US_ENT [.ENT_NUM])
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INSMEM);
RETURN;
END;
END;
.US_ENT [.ENT_NUM] = .LEN;
CH$MOVE (.LEN, CH$PTR (TEMP_BUFFER,, BYTE_SIZE),
CH$PTR (.US_ENT [.ENT_NUM] + 1,, BYTE_SIZE));
END;
[SET_NUMB] : ! Set numbers
NOS = 1;
[SET_NONUM] : ! Set nonumbers
NOS = 0;
[SET_QUIET] : ! Quiet
QUIET = 1;
[SET_NOQIT] : ! Noquiet
QUIET = 0;
[SET_SCRN] : ! Screen
BEGIN
IF (.EXE_CURCMD [SET_VAL] GTRU 255)
THEN
EDT$$FMT_MSG (EDT$_NUMVALILL)
ELSE
IF (EDT$$SC_SETWID (.EXE_CURCMD [SET_VAL])) THEN SCR_CHGD = 1;
!+
! Reabuild the screen data base, since in NOTRUNCATE mode the records may
! occupy a different number of screen lines.
!-
SCR_REBUILD = 1;
END;
[SET_SRCH] : ! Set search
CASE .EXE_CURCMD [SET_VAL] FROM SET_SGEN TO MAX_SET_SRCH OF
SET
[SET_SGEN] : ! General
EXCT_MATCH = 0;
[SET_SEXCT] : ! Exact
EXCT_MATCH = 1;
[SET_SEND, SET_SBEG] : ! Begin/End
SEA_BEG = .EXE_CURCMD [SET_VAL] - SET_SEND;
[SET_SUNB, SET_SBND] : ! Bounded/Unbounded
SEA_BNDD = .EXE_CURCMD [SET_VAL] - SET_SUNB;
[SET_SWPS] : ! WPS type search
EXCT_MATCH = 2;
[SET_CI] : ! Case insensitive
EXCT_MATCH = 3;
[SET_DI] : ! Diacritical insensitive
EXCT_MATCH = 4;
[SET_SIGN] : ! Ignore "string"
BEGIN
IF (.EXE_CURCMD [AS_LEN] GTR .IGN_LEN)
THEN
!+
!If new string is longer than the old one, get new memory
!-
BEGIN
EDT$$DEA_HEAP (IGN_LEN, IGN_PTR);
IF NOT EDT$$ALO_HEAP (EXE_CURCMD [AS_LEN], IGN_PTR)
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INSMEM);
RETURN;
END;
END;
IGN_PTR = CH$PTR (.IGN_PTR,, BYTE_SIZE);
IGN_LEN = .EXE_CURCMD [AS_LEN];
CH$MOVE (.EXE_CURCMD [AS_LEN], .EXE_CURCMD [AS_STR], .IGN_PTR);
END;
[SET_SNIGN]: ! Noignore
BEGIN
EDT$$DEA_HEAP (IGN_LEN, %REF (.IGN_PTR<0,18> + 1));
IGN_LEN = 0;
END;
[OUTRANGE] :
ASSERT (16, 0);
TES;
[SET_TAB] : ! Tab
BEGIN
IF (.EXE_CURCMD [SET_VAL] GTRU 255)
THEN
EDT$$FMT_MSG (EDT$_NUMVALILL)
ELSE
BEGIN
TAB_SIZ = .EXE_CURCMD [SET_VAL];
TAB_LVL = 1;
END;
END;
[SET_NOTAB] : ! Notab
TAB_SIZ = 0;
[SET_TERM] : ! Terminal
BEGIN
IF (.EXT_MOD AND (.EXE_CURCMD [SET_VAL] LSS SET_SCRL))
THEN
EDT$$FMT_MSG (EDT$_NOSETTRM)
ELSE
BEGIN
CASE .EXE_CURCMD [SET_VAL] FROM 1 TO MAX_SET_TERM OF
SET
[SET_VT52] : ! VT52
BEGIN
TI_TYP = TERM_VT52;
TI_SCROLL = 0;
END;
[SET_VT100] : ! VT100
BEGIN
TI_TYP = TERM_VT100;
TI_SCROLL = 1;
END;
[SET_HCPY] : ! HCPY
TI_TYP = TERM_HCPY;
[SET_SCRL] : ! SCROLL
TI_SCROLL = 1;
[SET_NSCRL] : ! NOSCROLL
TI_SCROLL = 0;
[SET_8BIT] : ! EIGHTBIT
BEGIN
%IF SUPPORT_VT220
%THEN
EIGHT_BIT = 1;
%ELSE
0
%FI
END;
[SET_N8BIT] : ! NOEIGHTBIT
BEGIN
%IF SUPPORT_VT220
%THEN
EIGHT_BIT = 0;
%ELSE
0
%FI
END;
[SET_EDIT] : ! EDIT
TI_EDIT = 1;
[SET_NEDIT] : ! NOEDIT
TI_EDIT = 0;
[OUTRANGE] :
ASSERT (16, 0);
TES;
SCR_CHGD = 1;
END;
END;
[SET_TRUNC] : ! Truncate
IF (.TRUN NEQ 1)
THEN
BEGIN
TRUN = 1;
SCR_REBUILD = 1;
END;
[SET_NOTRU] : ! Notruncate
TRUN = 0;
[SET_VERFY] : ! Verify
VFY = 1;
[SET_NOVER] : ! Noverify
VFY = 0;
[SET_WRAP] : ! Wrap
BEGIN
IF (.EXE_CURCMD [SET_VAL] GTRU 255)
THEN
EDT$$FMT_MSG (EDT$_NUMVALILL)
ELSE
WD_WRAP = .EXE_CURCMD [SET_VAL];
END;
[SET_NOWRP] : ! Nowrap
WD_WRAP = 256;
[SET_REPT] : ! Allow repeat counts
RPT = 1;
[SET_NORPT] : ! Don't allow repeat counts
RPT = 0;
[SET_SUMM] :
SUMRY = 1; ! Type out summary when exiting
[SET_NOSUM] :
SUMRY = 0; ! suppress summary when exiting
[SET_PROMPT] : ! Set prompt
BEGIN
LOCAL
LEN, ! Length of the prompt string
PROMPT_NUM, ! Number corresponding to which prompt
PROMPT_ADDR : REF VECTOR [32]; ! Address of prompt string
LEN = TRANS_CHAR (.EXE_CURCMD [AS_STR], .EXE_CURCMD [AS_LEN],
CH$PTR (TEMP_BUFFER,, BYTE_SIZE), 1);
PROMPT_NUM = .EXE_CURCMD [SET_VAL];
IF (.LEN GTR 31)
THEN
EDT$$FMT_MSG (EDT$_INVSTR)
ELSE
BEGIN
PROMPT_ADDR = (CASE .PROMPT_NUM FROM SET_PLINE TO MAX_SET_PROMPT OF
SET
[SET_PLINE] : PMT_LINE;
[SET_PKEY] : PMT_KPD;
[SET_PNKEY] : PMT_NOKPD;
[SET_PHCCH] : PMT_HCCHG;
[SET_PINS] : PMT_INS;
[SET_PNINS] : PMT_INSN;
[SET_PQRY] : PMT_QUERY;
[OUTRANGE] :
BEGIN
ASSERT (16, 0);
0
END;
TES);
!+
! Now copy the specified string into the global prompt string.
!-
PROMPT_ADDR [0] = .LEN;
CH$MOVE (.LEN, CH$PTR (TEMP_BUFFER,, BYTE_SIZE),
CH$PTR (.PROMPT_ADDR + 1,, BYTE_SIZE));
END
END;
[SET_TEXT] : ! Set up text
BEGIN
LOCAL
LEN,
LEN_PRV,
CHAR_PTR,
ESTATUS,
CHAR,
TEXT_NUM;
LEN = TRANS_CHAR (.EXE_CURCMD [AS_STR], .EXE_CURCMD [AS_LEN],
CH$PTR (TEMP_BUFFER,, BYTE_SIZE), 0);
TEXT_NUM = .EXE_CURCMD [SET_VAL] - 1;
ESTATUS = 1;
!+
! Make sure that there are no escape or control chars in the string
!-
CHAR_PTR = CH$PTR (TEMP_BUFFER,, BYTE_SIZE);
INCR I FROM 1 TO .LEN DO
BEGIN
CHAR = CH$RCHAR_A (CHAR_PTR);
IF ((.CHAR GEQ ASC_K_DEL) OR (.CHAR LSS ASC_K_SP))
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INVSTR); ! output error msg.
ESTATUS = 0;
EXITLOOP; ! exit--no reason to check rest
END;
END;
!+
! Get the length of the previous string
!-
IF (.ESTATUS NEQ 0)
THEN
BEGIN
LEN_PRV = ..US_TXT [.TEXT_NUM];
!+
! Allocate new memory if there is not enough space in the old area.
!-
IF (.LEN_PRV LSS .LEN)
THEN
BEGIN
EDT$$DEA_HEAP (%REF (.LEN_PRV + 5), US_TXT [.TEXT_NUM]);
IF NOT EDT$$ALO_HEAP (%REF (.LEN + 5), US_TXT [.TEXT_NUM])
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INSMEM);
RETURN;
END;
END;
.US_TXT [.TEXT_NUM] = .LEN;
CH$MOVE (.LEN, CH$PTR (TEMP_BUFFER,, BYTE_SIZE),
CH$PTR (.US_TXT [.TEXT_NUM] + 1,, BYTE_SIZE));
SCR_REBUILD = 1;
END;
END;
[SET_WORD] :
WRDTYP = .EXE_CURCMD [SET_VAL] - 1;
[SET_PARA] :
PARTYP = .EXE_CURCMD [SET_VAL] - 1;
[SET_HELP] : ! Set Help File Name
EDT$$SET_HLPFNAM (.EXE_CURCMD [FILSPEC], .EXE_CURCMD [FSPCLEN]);
[SET_AUTO] : ! Set Autorepeat
ENB_AUTRPT = 1;
[SET_NOAUT] : ! Set Noautorepeat
ENB_AUTRPT = 0;
[SET_COMND] : ! Set Command
BEGIN
IF (.EXE_CURCMD [FSPCLEN] EQL 0)
THEN
BEGIN
EDT$$FMT_MSG (EDT$_INVSTR);
END
ELSE
BEGIN
LOCAL
FILE_DESC : BLOCK [1];
STRING_DESC (FILE_DESC, EXE_CURCMD [FSPCLEN], .EXE_CURCMD [FILSPEC]);
EDT$$SET_COMFNAM (FILE_DESC);
END;
END;
[OUTRANGE] :
ASSERT (16, 0);
TES;
END; ! of routine EDT$$SET_CMD
!<BLF/PAGE>
%SBTTL 'TRANS_CHAR - Translate a character'
ROUTINE TRANS_CHAR ( ! Translate a character
SPTR, ! Source pointer
SLEN, ! Source length
DPTR, ! Destination pointer
TRN_CTRL) = ! Translate control chars.
BEGIN
!+
! FUNCTIONAL DESCRIPTION
!
! This routine translates pseudo-characters in the form <CR> to their
! actual binary value (13 in this case). This is required by the SET TEXT,
! SET PROMPT, and SET ENTITY commands since the parser cannot accept line
! termination caracters in a string.
!
!
! ROUTINE VALUE
!
! The routine value is the length of the destination string.
!-
MACRO
ENTRY (CHAR, LEN, VAL) =
FLD (UPLIT (%STRING (CHAR)), FLD_LHS) + FLD (LEN, %O'777000') + VAL %;
LITERAL
TBL_LEN = 6; ! Length of table
OWN
TRAN_TBL : VECTOR [TBL_LEN + 1] INITIAL (
ENTRY ('CR>', 3, ASC_K_CR),
ENTRY ('DEL>',4, ASC_K_DEL),
ENTRY ('ESC>',4, ASC_K_ESC),
ENTRY ('FF>', 3, ASC_K_FF),
ENTRY ('LF>', 3, ASC_K_LF),
ENTRY ('VT>', 3, ASC_K_CTRL_K));
LOCAL
CH, ! Character to translate
DLEN, ! Destination length
TBLENT, ! Table pointer
FLAG; ! TBLUK flags
DLEN = 0; ! Bias to 0
WHILE (.SLEN GTR 0) DO
BEGIN
CH = CH$RCHAR_A (SPTR);
SLEN = .SLEN - 1;
!+
! See if the character is "^", in which case it is a control character
! provided that the next character is in the range 100(8) to 176(8).
!-
IF .TRN_CTRL THEN
BEGIN
IF ((.CH EQL %C'^') AND (.SLEN GTR 0))
THEN
BEGIN
CH = CH$RCHAR_A (SPTR);
IF ((.CH GEQ %C'@') AND (.CH LSS %O'177'))
THEN
BEGIN
CH = .CH AND %O'37';
SLEN = .SLEN - 1;
END
ELSE
SPTR = CH$PLUS (.SPTR, -1);
END;
!+
! See if the character is "<", in which case it introduces a pseudo-character
!-
IF ((.CH EQL %C'<') AND (.SLEN GEQ 3)) THEN
BEGIN
INCR CTR FROM 0 TO TBL_LEN-1 DO
BEGIN
!+
! Search the table for the entry
!-
TBLENT = .TRAN_TBL [.CTR];
FLAG = CH$COMPARE (.TBLENT<9,9>,
CH$PTR (.TBLENT<18,18>),
.TBLENT<9,9>, .SPTR, 0);
IF (.FLAG GTR 0) THEN EXITLOOP; ! Too far
IF (.FLAG EQL 0) THEN
BEGIN
!+
! The string was a match, get the new character and correct the pointer
! and length.
!-
CH = .TBLENT<0,9>; ! Character code
SLEN = .SLEN - .TBLENT<9,9>;
SPTR = CH$PLUS (.SPTR, .TBLENT<9,9>);
EXITLOOP;
END;
END;
END;
END;
!+
! Now write the character to the destination
!-
CH$WCHAR_A (.CH, DPTR);
DLEN = .DLEN + 1;
END;
RETURN (.DLEN);
END;
END
ELUDOM