Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-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) DIGITAL EQUIPMENT CORPORATION 1981, 1988. 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 THAT 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