home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
turbopas
/
tp_tsr.arc
/
CMDQ.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-02-11
|
27KB
|
585 lines
{═══════════════════════════════ CMDQ.PAS ════════════════════════════════}
{ ───────── Turbo 4.0/5.0 stay-resident demonstration program ───────── }
{ Copyright (c) 1989 Richard W. Prescott }
{ This program provides basic line editing and recall capability at the }
{ DOS command line and within any program that requests keyboard input }
{ through interrupt $21 function $0A (Buffered Input). }
{ }
{ The Unit DOS21_0A contains the assembly code for the basic interrupt }
{ routine, which is installed automatically by the "Uses DOS21_0A" }
{ clause. This routine traps only function $0A (Buffered Input), }
{ chaining to the original interrupt $21 vector for all other function }
{ requests. The assembly code issues a FAR Call via the Pointer variable }
{ PascalCode which is initialized in the MAIN block (below) to point to }
{ the procedure ServiceProc. ServiceProc repeatedly polls the keyboard }
{ and calls the appropriate Proc/Function to provide the line edit and }
{ recall facilities. }
{ }
{ The Unit DOS21_0A provides the Procedures IChain for chaining to the }
{ original interrupt routine, and IReturn for returning directly to the }
{ calling program. These may be called from any point within the Pascal }
{ code. The user registers at interrupt entry are accessible through the }
{ record variable User^ (User^.Ax, User^.Flags, etc). They should be }
{ modified as necessary to simulate a successful interrupt request before }
{ calling IReturn, as illustrated in the procedure ReturnCommand. }
{ }
{ The Unit CONSOLE provides routines for changing the cursor shape, as }
{ well as substitutes for ReadKey, WhereX/Y, and WRITE. (The CRT Unit }
{ installs a considerable amount of initialization code, which is }
{ undesirable in a resident program; the CONSOLE Unit installs no }
{ initialization code). The substitutes for WRITE require less code and }
{ do not respond to Ctrl-C and Ctrl-Break. }
{═══════════════════════════════ CMDQ.PAS ════════════════════════════════}
{$M $400,0,0} {- INCREASE STACK during program development! -}
{$S-} {- REMOVE during program development! -}
{
┌─────────────────────────────────────────────────────────────────┐
│ The default configuration creates a true resident program. │
│ To create a version which runs a COMMAND.COM Shell, and can be │
│ removed with the DOS Command "Exit", $Define the conditional │
│ symbol SHELL or compile using "TPC cmdq/dshell". This is │
│ useful primarily during program development. │
└─────────────────────────────────────────────────────────────────┘
}
Uses DOS,CONSOLE,DOS21_0A;
CONST
DefaultMode = TRUE; {Default to Insert}
CONST
{- Standard SCAN Code Constants -}
F1 = $3B; F2 = $3C; F3 = $3D; F4 = $3E; F5 = $3F;
F6 = $40; F7 = $41; F8 = $42; F9 = $43; F0 = $44;
HomeKey = $47; CtrlHome = $77;
UpArrow = $48;
PgUp = $49; CtrlPgUp = $84;
LeftArrow = $4B; CtrlLeftArrow = $73;
RtArrow = $4D; CtrlRtArrow = $74;
EndKey = $4F; CtrlEnd = $75;
DownArrow = $50;
PgDn = $51; CtrlPgDn = $76;
InsertKey = $52; DeleteKey = $53;
{- Standard Character Constants -}
CtrlBkSl {^\} = #$1C;
BackSpace = #$08; CtrlBsp = #$7F;
Enter = #$0D; CtrlEnter = #$0A;
Escape = #$1B; Tab = #$09;
Null = #0;
TYPE
CmdType = STRING[255];
CONST
Dormant: BOOLEAN = FALSE;
VAR
CurrentLine: CmdType;
CurrentLineLen: BYTE Absolute CurrentLine;
MaxChars: BYTE; {- Maximum Space for Characters in user buffer -}
LinePos,SavePos: BYTE;
InsertMode: BOOLEAN;
CmdQ: ARRAY[0..$FF] OF BYTE; {- Command Queue -}
QTail,Qptr,Tptr: ^CmdType;
QTailLen: ^BYTE Absolute QTail;
QptrLen: ^BYTE Absolute QPtr;
TptrLen: ^BYTE Absolute TPtr;
QTailW: WORD Absolute QTail;
QptrW: WORD Absolute QPtr;
TptrW: WORD Absolute TPtr;
MarkX,MarkY: BYTE; Mark: WORD Absolute MarkX;
Ch: CHAR; Scan:Byte; Key: WORD Absolute Ch;
{════════════════════════════════ ReadKey ════════════════════════════════}
{ Emulate CRT Unit ReadKey without CRT Unit overhead. Ignore Ctrl-C and }
{ Ctrl-Break. Uses DosReadKey OR BiosReadKey from CONSOLE Unit, where }
{ DosReadKey recognizes ANSI macros and BiosReadKey does not. }
{════════════════════════════════ ReadKey ════════════════════════════════}
FUNCTION ReadKey: CHAR; BEGIN
ReadKey := DosReadKey; {- Use BiosReadKey to ignore ANSI Macros -}
END; {FUNCTION ReadKey}
{══════════════════════════════ ShowCursor ═══════════════════════════════}
{ Reset cursor shape based on state of InsertMode flag. }
{══════════════════════════════ ShowCursor ═══════════════════════════════}
PROCEDURE ShowCursor; BEGIN
IF InsertMode THEN WideCursor ELSE ThinCursor;
END; {PROCEDURE ShowCursor}
{══════════════════════════════ CursorLeft ═══════════════════════════════}
{ Move cursor left (or reverse line wrap) and update GLOBAL VAR LinePos. }
{ Cursor is moved by sending a BackSpace (#8), which allows for reverse }
{ line wrap within windows defined under certain BIOS enhancements (e.g. }
{ FANSI-CONSOLE). If x position does not change, implement reverse line }
{ wrap by decrementing y position and setting x position to the maximum }
{ screen column as determined from the BIOS. }
{══════════════════════════════ CursorLeft ═══════════════════════════════}
PROCEDURE CursorLeft; BEGIN
IF LinePos>1 THEN BEGIN
Mark := ReadCursor;
WriteChar(#8); Dec(LinePos);
IF WhereX = MarkX THEN BEGIN
Dec(MarkY); MarkX := MaxColumn; SetCursor(Mark);
END; {IF WhereX = MarkX THEN }
END; {IF LinePos>1 THEN }
END; {PROCEDURE CursorLeft}
{═══════════════════════════════ WordLeft ════════════════════════════════}
{ Move cursor to preceding "word start" and update GLOBAL VAR LinePos. }
{ A "word start" is a non-space preceded by a space (or the line start). }
{═══════════════════════════════ WordLeft ════════════════════════════════}
PROCEDURE WordLeft; BEGIN
IF LinePos > 1
THEN REPEAT CursorLeft
UNTIL (LinePos = 1)
OR ((CurrentLine[LinePos]<>' ') AND (CurrentLine[LinePos-1]=' '));
END; {PROCEDURE WordLeft}
{══════════════════════════════ CursorRight ══════════════════════════════}
{ Move cursor right (or wrap to next line) and update GLOBAL VAR LinePos. }
{ Cursor is moved by writing the character at the current LinePos to the }
{ console, providing automatic line wrap and scrolling as required. }
{══════════════════════════════ CursorRight ══════════════════════════════}
PROCEDURE CursorRight; BEGIN
IF LinePos <= CurrentLineLen THEN BEGIN
WriteChar(CurrentLine[LinePos]); Inc(LinePos);
END; {IF LinePos>1 THEN }
END; {PROCEDURE CursorRight}
{═══════════════════════════════ WordRight ═══════════════════════════════}
{ Move cursor to following "word start" and update GLOBAL VAR LinePos. }
{ A "word start" is a non-space preceded by a space (or the line end). }
{═══════════════════════════════ WordRight ═══════════════════════════════}
PROCEDURE WordRight; BEGIN
IF LinePos <= CurrentLineLen
THEN REPEAT CursorRight
UNTIL (LinePos > CurrentLineLen)
OR ((CurrentLine[LinePos]<>' ') AND (CurrentLine[LinePos-1]=' '));
END; {PROCEDURE WordRight}
{═══════════════════════════════ CursorHome ══════════════════════════════}
{ Move cursor to the beginning of the line and update GLOBAL VAR LinePos. }
{═══════════════════════════════ CursorHome ══════════════════════════════}
PROCEDURE CursorHome; BEGIN
WHILE LinePos>1 DO CursorLeft;
END; {PROCEDURE CursorHome}
{═══════════════════════════════ CursorEnd ═══════════════════════════════}
{ Move cursor to the end of the line and update GLOBAL VAR LinePos. }
{═══════════════════════════════ CursorEnd ═══════════════════════════════}
PROCEDURE CursorEnd; BEGIN
WHILE LinePos <= CurrentLineLen DO CursorRight;
END; {PROCEDURE CursorEnd}
{═══════════════════════════════ ToggleMode ══════════════════════════════}
{ Toggle cursor size and update GLOBAL Flag InsertMode. }
{═══════════════════════════════ ToggleMode ══════════════════════════════}
PROCEDURE ToggleMode; BEGIN
InsertMode := NOT InsertMode;
ShowCursor;
END; {PROCEDURE ToggleMode}
{═══════════════════════════════ InsertChar ══════════════════════════════}
{ Insert character at cursor position (moving existing characters and }
{ cursor one position right) and update GLOBAL VARs CurrentLine and }
{ LinePos. Uses SetCursor to restore cursor after screen update. Note }
{ however that the last Char written by WriteSubStr may cause the screen }
{ to scroll, making MarkY invalid. If WhereY (after update) = MarkY }
{ (before update) check for scroll by sending a BackSpace; if the cursor }
{ does not move, a scroll has occurred (decrement MarkY to correct). If }
{ it does move, set MarkY = WhereY in case the screen DID scroll but the }
{ BackSpace caused a reverse line wrap (Supports FANSI-CONSOLE Windows) }
{═══════════════════════════════ InsertChar ══════════════════════════════}
PROCEDURE InsertChar(Ch1: CHAR); VAR Mark2: WORD; BEGIN
IF CurrentLineLen < MaxChars-1 THEN BEGIN
Insert(ch1,CurrentLine,LinePos); CursorRight; { Display Ch/move right }
Mark := ReadCursor;
WriteSubStr(CurrentLine,LinePos,1+CurrentLineLen-LinePos);
IF (LinePos <= CurrentLineLen) AND (WhereY = MarkY) THEN BEGIN
Mark2 := ReadCursor; WriteChar(#8); { Send BackSpace }
IF Mark2 = ReadCursor THEN Dec(MarkY) { Scrolled: Adjust MarkY }
ELSE MarkY := WhereY; { No Scroll or Scroll & reverse wrap }
END; {IF WhereY = MarkY THEN }
SetCursor(Mark);
END; {IF CurrentLineLen < MaxChars-1}
END; {PROCEDURE InsertChar}
{═══════════════════════════════ OverWrite ═══════════════════════════════}
{ Replace character at current cursor position and move right. }
{ Updates GLOBAL VARs CurrentLine and LinePos. }
{═══════════════════════════════ OverWrite ═══════════════════════════════}
PROCEDURE OverWrite(ch1: CHAR); BEGIN
IF LinePos < MaxChars THEN BEGIN
IF LinePos > CurrentLineLen THEN Inc(CurrentLineLen);
WriteChar(Ch1); CurrentLine[LinePos] := Ch1; Inc(LinePos);
END; {IF LinePos < MaxChars}
END; {PROCEDURE OverWrite}
{═══════════════════════════════ DeleteChar ══════════════════════════════}
{ Delete character at cursor position (moving trailing characters one }
{ one position left) and update GLOBAL VAR CurrentLine. Cursor position }
{ is not changed. }
{═══════════════════════════════ DeleteChar ══════════════════════════════}
PROCEDURE DeleteChar; BEGIN
IF LinePos <= CurrentLineLen THEN BEGIN
Mark := ReadCursor; Delete(CurrentLine,LinePos,1);
WriteSubStr(CurrentLine,LinePos,1+CurrentLineLen-LinePos);
WriteChar(' '); SetCursor(Mark);
END; {IF LinePos <= CurrentLineLen THEN }
END; {PROCEDURE DeleteChar}
{═══════════════════════════════ DeleteLeft ══════════════════════════════}
{ Delete character to left of cursor (moving existing characters and }
{ cursor one position left) and update GLOBAL VARs CurrentLine and }
{ LinePos. }
{═══════════════════════════════ DeleteLeft ══════════════════════════════}
PROCEDURE DeleteLeft; BEGIN
IF LinePos>1 THEN BEGIN
CursorLeft; DeleteChar;
END; {IF LinePos>1 THEN }
END; {PROCEDURE DeleteLeft}
{═══════════════════════════════ DisplayNew ══════════════════════════════}
{ Replace CurrentLine with new command (Cmd), and set LinePos to end of }
{ line. Erase trailing characters of old line as indicated by OldLen. }
{ Used by EraseLine, DeleteHome, DeleteEnd, PrevCommand, NextCommand, }
{ and ClearCommand. }
{═══════════════════════════════ DisplayNew ══════════════════════════════}
PROCEDURE DisplayNew(VAR Cmd: CmdType; OldLen: BYTE);
VAR n:BYTE; CmdLen: BYTE Absolute Cmd; BEGIN
CursorHome;
WriteSubStr(Cmd,1,CmdLen);
IF OldLen > CmdLen THEN BEGIN
Mark := ReadCursor;
FOR n := CmdLen TO OldLen-1 DO WriteChar(' ');
SetCursor(Mark);
END; {IF OldLen > CmdLen THEN }
CurrentLine := Cmd; LinePos := CurrentLineLen+1;
END; {PROCEDURE DisplayNew}
{═══════════════════════════════ EraseLine ═══════════════════════════════}
{ Erase current display line and update GLOBAL VAR CurrentLine. }
{═══════════════════════════════ EraseLine ═══════════════════════════════}
PROCEDURE EraseLine; BEGIN
SavePos := CurrentLineLen;
CurrentLineLen := 0;
DisplayNew(CurrentLine,SavePos);
END; {PROCEDURE EraseLine; }
{═══════════════════════════════ DeleteHome ══════════════════════════════}
{ Delete characters left of cursor and update GLOBAL VAR CurrentLine. }
{ Cursor is placed at the beginning of the new line. }
{═══════════════════════════════ DeleteHome ══════════════════════════════}
PROCEDURE DeleteHome; BEGIN
IF LinePos>1 THEN BEGIN
SavePos := CurrentLineLen;
Delete(CurrentLine,1,LinePos-1);
DisplayNew(CurrentLine,SavePos);
CursorHome;
END; {IF LinePos>1 THEN }
END; {PROCEDURE DeleteHome}
{═══════════════════════════════ DeleteEnd ═══════════════════════════════}
{ Delete characters from cursor to end of line and update GLOBAL VAR }
{ CurrentLine. Cursor is left at the end of the line. }
{═══════════════════════════════ DeleteEnd ═══════════════════════════════}
PROCEDURE DeleteEnd; BEGIN
IF LinePos <= CurrentLineLen THEN BEGIN
SavePos := CurrentLineLen;
CurrentLineLen := LinePos-1;
DisplayNew(CurrentLine,SavePos);
END; {IF LinePos <= CurrentLineLen THEN }
END; {PROCEDURE DeleteEnd}
{══════════════════════════════════════════════════════════════════}
{ The following five proceduress manipulate the command queue. }
{ Commands are stored with a leading AND trailing length byte as }
{ illustrated below: }
{ [L0]Cmd0[L0] [L1]Cmd1[L1] [L2]Cmd2[L2] [L3][L3] }
{ ^Ofs(CmdQ) ^QPtr ^QTail }
{ QPtr points to the currently displayed command, viewed as a }
{ String. QPtrLen points to the same location but refers to the }
{ length byte only. It is used to determine the start of the next }
{ command (Length+2 bytes forward). QPtrW refers to the offset }
{ portion of the pointer QPtr/QPtrLen. It is adjusted directly to }
{ change the command referenced by QPtr. To move backward in the }
{ queue, QPtrW is decremented so that QPtrLen refers to the }
{ trailing length byte of the preceding command. The start of the }
{ command is then Length+1 bytes backward. }
{ The oldest command is always at offset 0 within CmdQ, while }
{ QTail points to the next available location to store a command. }
{ If there is not sufficient space at QTail to store a new command }
{ the oldest command is discarded and the remaining ones shifted }
{ left so that the oldest remaining command is again at Ofs(CmdQ). }
{══════════════════════════════════════════════════════════════════}
{══════════════════════════════ NextCommand ══════════════════════════════}
{ Advance QPtr to next command in queue and display it. If pointer }
{ reaches QTail, cycle back to start of CmdQ (oldest command). }
{══════════════════════════════ NextCommand ══════════════════════════════}
PROCEDURE NextCommand; VAR n:BYTE; BEGIN
IF QTail = @CmdQ THEN Exit;
IF QPtr = QTail THEN QPtr := @CmdQ
ELSE Inc(QPtrW, QPtrLen^ + 2);
IF QPtr = QTail THEN QPtr := @CmdQ;
DisplayNew(QPtr^,CurrentLineLen);
END; {PROCEDURE NextCommand}
{══════════════════════════════ PrevCommand ══════════════════════════════}
{ If display is blank, display current command at QPtr. Otherwise move }
{ QPtr back to previous command in queue and display it. If pointer was }
{ at start of CmdQ (oldest command), cycle to QTail before moving back. }
{══════════════════════════════ PrevCommand ══════════════════════════════}
PROCEDURE PrevCommand; BEGIN
IF QTail = @CmdQ THEN Exit;
IF (QPtr = QTail) OR (CurrentLineLen<>0) THEN BEGIN
IF Qptr = @CmdQ THEN QPtr := QTail;
Dec(QptrW); {Now Pointing to length of Prev Command}
Dec(QptrW, QPtrLen^ + 1);
END; {IF (QPtr = QTail) OR (CurrentLineLen<>0) THEN }
DisplayNew(QPtr^,CurrentLineLen);
END; {PROCEDURE PrevCommand}
{═════════════════════════════ ClearCommand ══════════════════════════════}
{ Remove currently displayed command from command queue. Shift remaining }
{ commands back to fill the gap, and display the new command at QPtr (the }
{ command following the one removed). }
{═════════════════════════════ ClearCommand ══════════════════════════════}
PROCEDURE ClearCommand; BEGIN
IF CurrentLine <> QPtr^ THEN BEGIN EraseLine; Exit; END;
IF (QTail = @CmdQ) OR (QPtr = QTail) THEN Exit;
Tptr := Qptr;
Inc(TPtrW, QPtrLen^ + 2);
Move(TPtr^,QPtr^,Ofs(CmdQ)+SizeOf(CmdQ)-TPtrW);
Dec(QTailW,TPtrW-QPtrW);
MemW[Dseg:QTailW]:=0;
IF QPtr = QTail THEN QPtr := @CmdQ;
DisplayNew(QPtr^,CurrentLineLen);
END; {PROCEDURE ClearCommand}
{═══════════════════════════════ ClearQueue ══════════════════════════════}
{ Remove all commands from command queue and display a blank line. }
{═══════════════════════════════ ClearQueue ══════════════════════════════}
PROCEDURE ClearQueue; BEGIN
EraseLine;
Qtail:=@CmdQ; QPtr:=QTail; MemW[Dseg:Ofs(CmdQ)]:=0;
END; {PROCEDURE ClearQueue}
{══════════════════════════════ QueueCommand ═════════════════════════════}
{ Append currently displayed command to command queue. If sufficient }
{ space is not available at QTail, discard oldest command(s) and move }
{ remaining commands back until oldest remaining command is at Ofs(CmdQ). }
{══════════════════════════════ QueueCommand ═════════════════════════════}
PROCEDURE QueueCommand; BEGIN
TPtr := @CmdQ;
WHILE CurrentLineLen+2+QTailW-TPtrW > SizeOf(CmdQ)
DO Inc(TPtrW, TPtrLen^ + 2);
IF TPtrW <> Ofs(CmdQ)
THEN Move(TPtr^,CmdQ,Ofs(CmdQ)+SizeOf(CmdQ)-TPtrW);
Dec(QTailW,TPtrW-Ofs(CmdQ));
QTail^ := CurrentLine; {- Add command string -}
Inc(QTailW,CurrentLineLen+1);
QTailLen^ := CurrentLineLen; {- Add trailing length byte -}
Inc(QTailW); {- Set new QTail -}
QPtr := QTail; {- Set Qptr to new QTail -}
END; {PROCEDURE QueueCommand}
{═════════════════════════════ ReturnCommand ═════════════════════════════}
{ Execute return from interrupt. Place currently displayed command }
{ STRING (including Length byte) at offset 1 within callers buffer at }
{ Ds:Dx, and add trailing Carriage Return (#13, not counted in length). }
{ This emulates the documented action of Interrupt $21 function $0A: }
{ Input Buffer: [BufferSize][Length][Line Returned][#13] }
{ Caller's Ds:Dx ^+0 ^+1 ^+2 ^+Length+2 }
{ The Buffer Size at Ds:Dx is supplied by the caller. It is read into }
{ MaxChars (below) and used by InsertChar and OverWrite to limit the }
{ maximum allowable size of CommandLine. }
{═════════════════════════════ ReturnCommand ═════════════════════════════}
PROCEDURE ReturnCommand; BEGIN
CurrentLine[CurrentLineLen+1] := #13;
Move(CurrentLine,Mem[User^.Ds:User^.Dx +1],CurrentLineLen+2);
CursorEnd; {- for wrapped lines -}
ShowCursor; {- during command execution -}
Dos21_0A.IReturn;
END; {PROCEDURE ReturnCommand}
{══════════════════════════════ QueueReturn ══════════════════════════════}
{ Return Command, adding it to the command queue if new or modified. }
{ Short commands are not added to the queue. }
{══════════════════════════════ QueueReturn ══════════════════════════════}
PROCEDURE QueueReturn; BEGIN
IF (CurrentLineLen > 2)
AND (CurrentLine <> QPtr^)
THEN QueueCommand;
ReturnCommand;
END; {PROCEDURE QueueReturn}
{══════════════════════════════ MacroReturn ══════════════════════════════}
{ Return a predefined command if one is defined for the Scan code of the }
{ key pressed. Otherwise exit with no action. Macro commands are not }
{ added to the queue. This feature may be removed or expanded as desired }
{══════════════════════════════ MacroReturn ══════════════════════════════}
PROCEDURE MacroReturn; BEGIN
SavePos := CurrentLineLen;
CASE Scan OF
F1: CurrentLine := 'exit';
F5: CurrentLine := 'dir c:';
else Exit;
END; {CASE Scan}
DisplayNew(CurrentLine,SavePos);
ReturnCommand; {- Return Command without adding to queue -}
END; {PROCEDURE MacroReturn;
{══════════════════════════════ DisplayPath ══════════════════════════════}
{ Display current directory if caller is COMMAND.COM and default drive }
{ is C or higher. }
{══════════════════════════════ DisplayPath ══════════════════════════════}
PROCEDURE DisplayPath; VAR Directory: STRING[67]; BEGIN
IF (DefaultDrive >= 'C') AND (User^.Ds = CommandSig)
AND (WhereX = 3) THEN BEGIN
GetDir(0,Directory);
WriteChar(#8); WriteChar(#8);
WriteSubStr(Directory,1,Length(Directory));
WriteChar('>');
END; {IF DefaultDrive >= 'C' THEN }
END; {PROCEDURE DisplayPath; }
{══════════════════════════════ ServiceProc ══════════════════════════════}
{ This is the Pascal code for the interrupt service routine, called from }
{ DOS21_0A.IHook. If Dormant, checks FIRST keystroke of each line }
{ requested for the wakeup combination Ctrl-\. If active, initialize }
{ CurrentLine and cursor shape, read Caller's buffer size into MaxChars, }
{ and display current directory path (except floppy drives). Then poll }
{ the keyboard and execute edit requests until carriage return or macro. }
{ If Ctrl-\ is pressed while active, set Dormant flag and chain to the }
{ original interrupt service routine. }
{══════════════════════════════ ServiceProc ══════════════════════════════}
{$F+} PROCEDURE ServiceProc; {$F-} {- Force FAR Return -}
{- The Pascal code for the Interrupt Service must be a FAR Procedure -}
BEGIN
IF Dormant THEN BEGIN
Key := LookAhead; {- Inspect Key but leave in buffer -}
IF Ch = CtrlBkSl
THEN BEGIN Dormant := FALSE; Ch := ReadKey; END
ELSE Dos21_0A.IChain;
END; {IF Dormant THEN }
LinePos := 1; CurrentLineLen := 0;
InsertMode := DefaultMode; ShowCursor; {- set default -}
MaxChars := Mem[User^.Ds:User^.Dx];
DisplayPath;
REPEAT
{- Display cursor during wait for keystroke -}
ShowCursor; Ch := ReadKey; HideCursor;
CASE Ch OF
CtrlBkSl: BEGIN Dormant := TRUE; EraseLine;
ShowCursor; Dos21_0A.IChain;
END;
Enter: QueueReturn;
Escape: EraseLine;
BackSpace: DeleteLeft;
#32..#255: {- Printable Character -}
IF InsertMode THEN InsertChar(ch) ELSE OverWrite(ch);
Null: BEGIN {- Extended Key -}
ShowCursor; Scan := Byte(ReadKey); HideCursor;
CASE Scan OF
LeftArrow: CursorLeft; RtArrow: CursorRight;
CtrlLeftArrow: WordLeft; CtrlRtArrow: WordRight;
HomeKey: CursorHome; EndKey: CursorEnd;
CtrlHome: DeleteHome; CtrlEnd: DeleteEnd;
DeleteKey: DeleteChar; InsertKey: ToggleMode;
UpArrow: PrevCommand; DownArrow: NextCommand;
CtrlPgDn: ClearCommand; CtrlPgUp: ClearQueue;
else MacroReturn;
END; {CASE Scan }
END; {Null: }
END; {CASE Ch}
UNTIL FALSE;
END; {PROCEDURE ServiceProc}
{═════════════════════════════════ Shell ═════════════════════════════════}
{ Set Sp for Exec Call to avoid our interrupt service stack, then Exec }
{ COMMAND.COM, looking first on Drive C and then on Drive A. One could }
{ also scan the environment block to find the current COMSPEC (even }
{ though the memory block has been released), but the present method is }
{ considerably simpler. On return from Exec, restore original interrupt. }
{═════════════════════════════════ Shell ═════════════════════════════════}
{$IFDEF Shell} {- Avoid unneeded data ErrMsg IFNDEF Shell -}
PROCEDURE Shell;
CONST ErrMsg: STRING[25] = 'A:\COMMAND.COM Not Found'#10;
BEGIN
{- Set Sp low to insure that "resident" stack doesn't overlay Exec Return -}
SetSpLow;
Exec('C:\Command.com','');
IF DosError <> 0 THEN Exec('A:\Command.com','');
IF DosError <> 0 THEN WriteSubStr(ErrMsg,1,Length(ErrMsg));
Dos21_0A.Irestore;
{- NOTE that Sp is restored by the standard PROCEDURE exit code -}
END; {PROCEDURE Shell; }
{$ENDIF}
{══════════════════════════════════ MAIN ═════════════════════════════════}
{ Initialize Command Queue and set PascalCode Pointer to @ServiceProc. }
{ Release unneeded environment block, then Shell or go resident. }
{══════════════════════════════════ MAIN ═════════════════════════════════}
BEGIN {- MAIN PROGRAM SETUP -}
Qtail:=@CmdQ; QPtr:=QTail; MemW[Dseg:Ofs(CmdQ)]:=0;
Dos21_0A.PascalCode := @ServiceProc;
FreeEnvironmentBlock;
{$IFDEF Shell} Shell; {$ELSE} Keep(0); {$ENDIF}
END.