* Shell - runs under KEDIT, passes unknown commands to DOS
* Command history is maintained
* Andrei Zaitsev (daugava2@yahoo.com)
TM='C:\TEMP\SHELL.TMP'
'NOMSG ERASE' TM
AR=COLOR.2()
BAR=SUBWORD(AR,3)
'COLOR ARROW RED' BAR
DOSY=INI() /* List of DOS commands, updated by shell automatically */
OD=WORDS(DOSY)

DO FOREVER
   'READV KEY'
   R=READV.1
   IF R='ESC' THEN LEAVE
   IF R='ENTER' THEN DO
	  CMD=CMDLINE.3()
	  'PUT LINE' TM CMD
   END
   IF R='F6' THEN DO
	  IF ^EXISTS(TM) THEN DO
		 SAY 'History buffer is empty'
		 ITERATE
	  END
	  CMD=HI()
	  IF CMD=-1 THEN ITERATE
	  IF WORD(CMD,1)='DELAY' THEN DO
		 PARSE VAR CMD . CMD
		 'CMSG' CMD
		 'SOS ENDCHAR'
		 ITERATE
	  END
	  'CMSG' CMD
	  READV.1='ENTER'
   END
   IF WORDPOS(CMD,DOSY)=0 THEN 'MACRO' READV.1
   ELSE RC=-1 /* We know this is DOS command, do not try to pass to KEDIT */
   IF RING.0()=0 THEN EXIT
   IF RC=-1 THEN DO
	  DOSY=DOSY WORD(CMD,1)
	  'DOS' CMD
	  CMD=''
	  'CMSG'
	  'SOS FIRSTCOL'
   END
END

IF WORDS(DOSY)>OD THEN DO /* New DOS commands detected */
   'X C:\TEMP\SHELL.INI'
   'NOMSG :1'
   'R' DOSY
   'FFILE'
END
'COLOR' AR
EXIT

HI: PROCEDURE
'X C:\TEMP\SHELL.TMP'
C=LIST('','Command History',ESC)
'QUIT'
RETURN C

*GET LIST
*GET LIST
LIST:
* 2.12 - Makes curline same color as filearea.
* 2.11 - Allows footer display
* 2.1 - supports multiple response
* 2.05 - will load list from current file if LABELS=''
*  also, passes ESC parm to POKE (which maybe INSDEL or just non-empty)
* Version 2.02 - restore statusline & mousebar settings
* Version 2.03 - supports different screen sizes, centers properly
* Version 2.04 - if filename is omitted, displays curfile
'COLOR C'COLOR.3() /* same as block */
'COLOR CURLINE' SUBWORD(COLOR.12(),2) /* same as filearea */
STL=STATUSLINE.1()
MOU=MOUSEBAR.1()
'POINT .LJOB'
PARSE ARG LABELS,MSG,ESC,TYP,FOOT
IF LABELS<>'' THEN 'KEDIT' LABELS '(NOPROF)'
LBLS=RANGE.2()-RANGE.1()+1
/**LBLS=SIZE.1() */
LINES=LBLS+3
ST= (PSCREEN.1() - LINES) % 2
IF ST<=0 THEN ST=1
CALL CLEAR
IF FOOT<>'' THEN 'MACRO MERZAJAC' FOOT
CALL SMALLBOX ST,ST+2,'BRIGHT WHITE on CYAN', MSG, D2C(176)
'SET CURLINE' ST+4

LON=LONGEST()
':'RANGE.1()
LE=LENGTH(CURLINE.3())
SH=(80-LE) % 2
IF SIZE.1()>0 & SH>0 & VERSHIFT.1()=0 THEN 'LEFT' SH

T=POKE(SH+1,LON,ESC,TYP)
IF LABELS<>'' THEN 'QQUIT'
'LOCATE .LJOB'
'SET STATUSLINE' STL
'SET MOUSEBAR' MOU
RETURN STRIP(T)

LONGEST:
'TOP'
LO=0
DO FOREVER
   'NEXT'
   IF RC>0 THEN LEAVE
   L=CURLINE.3()
   LL=LENGTH(L)
   IF LL>LO THEN LO=LL
END
RETURN LO

*GET POKE
POKE: PROCEDURE
* 2.8 - Uses less nested blocks to avoid 'control stack full'
* 2.7 - Supports multiple response
* 2.6 - when ESC is set to INSDEL, allows these keys, sets EDITV VAR SPEC
*Version 2.05 - supports configurable ESC key
*Version 2.04 - does not use buggy SOS CURRENT
* 2.01 - LS fix, 2.02 - fix for LIST speedsearch,
* 2.03 - no PgUp/Dn for short files
ARG SH, LE, ESC, TYP
IF SH='' THEN SH=1
IF LE='' THEN LE=79
'CURSOR FILE' LINE.1() SH
'SOS FIRSTCHAR'
SEL=0
SIZ=SIZE.1()
DO FOREVER
   'RESET BLOCK'
	'MARK BOX'
	'CURSOR =' SH+LE
	'MARK BOX'
	'CURSOR =' SH
   'READV KEY'
   IF READV.1 = 'CURU' THEN DO
	  IF LINE.1()=RANGE.1() THEN NOP
	  ELSE 'CURSOR UP'
	  ITERATE
   END
   IF READV.1 = 'CURD' THEN DO
	  IF LINE.1()=RANGE.2() THEN NOP
	  ELSE 'CURSOR DOWN'
	  ITERATE
   END
   IF READV.1 = 'PGUP' THEN DO
	  IF SIZE.1()>20 THEN DO
		 'BACKWARD'
		 IF LINE.1()=0 THEN 'CURSOR DOWN'
	  END
	  ITERATE
   END
   IF READV.1 = 'PGDN' THEN DO
	  IF SIZE.1()>20 THEN DO
		 'FORWARD'
		 IF EOF() THEN 'CURSOR UP'
	  END
	  ITERATE
   END
   IF READV.1 = 'HOME' THEN DO
	  IF LINE.1()<>1 THEN ':1'
	  ITERATE
   END
   IF READV.1 = 'END' THEN DO
	  'BOT'
	  ITERATE
   END
   IF READV.1 = 'ESC' THEN DO
	  IF ESC<>'' THEN RETURN -1
	  ITERATE
   END
   IF READV.1 = 'INS' | READV.1='DEL' THEN DO
	  IF ESC='INSDEL' THEN DO
		 'EDITV SET SPEC' READV.1
		 RETURN CURLINE.3()
	  END
	  ITERATE
   END
   IF READV.1 = 'ENTER' THEN DO
	  RETURN CURLINE.3()
	  ITERATE
   END
   IF READV.1 = 'C-ENTER' THEN DO
	  RETURN 'DELAY' CURLINE.3()
	  ITERATE
   END
   IF DATATYPE(READV.2,'A') THEN DO
	  TRG=UPPER(READV.2)
	  CALL SPEEDSEARCH
	  ITERATE
   END
   IF READV.2=' ' & TYP='MULTIPLE' THEN DO
	  L=CURLINE.3()
	  FC=LEFT(l,1)
	  'CFIRST'
	  IF FC='û' THEN 'COV  '
	  ELSE 'COV û'
	  SEL=SEL+1
	  ITERATE
   END
END
RETURN -1

SPEEDSEARCH:
SL=LINE.1()
IF ^DATATYPE(LS,'N') THEN LS=1
DO FOREVER
   'NEXT'
   IF RC>0 THEN ':'LS
   L=LINE.1()
   IF L=SL THEN LEAVE
   N=CURLINE.3()
   N=UPPER(SUBSTR(STRIP(N),1,1))
   IF N=TRG THEN LEAVE
END
RETURN

*GET CLEAR
CLEAR:PROCEDURE
'STATUSLINE OFF'
'IDLINE OFF'
'PRE OFF'
'SCALE OFF'
'ARROW OFF'
'MOUSEBAR OFF'
IF RESER.0()>0 THEN DO
   WR=WORDS(RESER.1())
   R=RESER.1()
   DO I=1 TO WR
	  W=WORD(R,I)
	  'RESER' W 'OFF'
   END
END
RETURN

*GET SMALLBOX
SMALLBOX: PROCEDURE
*Version 2.04 - defaults in the middle of screen
*Version 2.03 - REALLY fixed centering. 2.02 broke it
PARSE ARG Y1,Y2, COLOR, TEXT, FILLC
IF Y1='' THEN Y1=11
IF Y2='' THEN Y2=13
IF TEXT='' THEN CALL ERR "Programmer's error in SMALLBOX procedure - no text specified"
IF FILLC=='' THEN FILLC=D2C(177)  /* Exact match, SPACE will fail  */

LT=LENGTH(TEXT)+2
BEF=(80 - LT - 4) % 2
BEFORE=COPIES(FILLC,BEF)
AFTER=COPIES(FILLC,BEF+3)

IF COLOR='' THEN COLOR='RED ON WHITE'
'RESER' Y1 COLOR BEFORE || 'É' || COPIES('Í',LT) || '»' || AFTER
'RESER' Y2 COLOR BEFORE || 'È' || COPIES('Í',LT) || '¼' || AFTER
DO I=Y1+1 TO Y2-1
   'RESER' I COLOR BEFORE || 'º' COPIES(' ',LT) || 'º' || AFTER
END
MI=Y1+1
'RESER' MI COLOR BEFORE || 'º' TEXT 'º' || AFTER

RETURN

*GET ERR
ERR: PROCEDURE
'ALERT' DELIMIT(CURLINE.3()) 'TITLE' DELIMIT(ARG(1))
EXIT

INI: PROCEDURE
'X C:\TEMP\SHELL.INI'
IF SIZE.1()=0 THEN L=''
ELSE DO
   ':1'
   L=CURLINE.3()
END
'QUIT'
RETURN L

*GET EXISTS
EXISTS: PROCEDURE
* Version 2.01
ARG A
IF POS('.',A)=0 THEN A=A'.'
'NOMSG DIR' ARG(1)
IF RC=0 THEN DO
   'QQUIT'
   RETURN 1
END
ELSE RETURN 0