PSION CD 2/PsionCDVol2.iso/Programs/283/Shell5SourceCode.sis/sh5_021

EPOC OPL Source | 1998-08-30 | 113.1 KB | 5,031 lines

Rem   Shell5, a command line interpreter for the Psion Series 5 Computer.
Rem   Version 2.0 beta 2, build 21
Rem   Copyright (C) 1998  Nick Murray
Rem
Rem   This program is free software; you can redistribute it and/or
Rem   modify it under the terms of the GNU General Public License
Rem   as published by the Free Software Foundation; either version 2
Rem   of the License, or (at your option) any later version.
Rem
Rem   This program is distributed in the hope that it will be useful,
Rem   but WITHOUT ANY WARRANTY; without even the implied warranty of
Rem   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
Rem   See the GNU General Public License for more details.
Rem
Rem   You should have received a copy of the GNU General Public License
Rem   along with this program; if not, write to the Free Software Foundation,
Rem   Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
Rem
INCLUDE "system.oxh"
INCLUDE "sysram1.oxh"
INCLUDE "toolbar.oph"
INCLUDE "const.oph"
INCLUDE "date.oxh"
CONST _VERSION$="2.0(b2)"
Rem VERY, VERY important. If the order of the offsets below is
Rem    changed the source MUST be checked, as many of these
Rem    values are set simultaneously with POKEW & POKEL's
CONST PR_ARGC%=0
CONST PR_LEV%=1
CONST PR_FLAG%=2
CONST PR_ARGN%=3
CONST PR_OUT%=4
CONST PR_IN%=6
CONST PR_INPST%=8
CONST PR_INPPS%=9
CONST PR_OFFSET%=10
CONST PR_BACK%=11
CONST PR_NUM%=15
CONST PR_STATUS%=17
CONST PR_ARGV%=19
CONST SEG_SIZE%=531
CONST varUNIXPath%=1
CONST varUNIXVar%=2
CONST varAppend%=3
CONST varEcho%=4
CONST varcwdcmd%=5
CONST ShellUID&=&10000C64        Rem also used in edit% so define once
APP Shell5,ShellUID&
    ICON "shell5.mbm"
    CAPTION "Shell5",1
ENDA

CONST NBUILTIN%=40

PROC main:
GLOBAL ScrWid%                                Rem pixel width initially
GLOBAL ScrHght%                            Rem pixel height initially
    ScrWid%=gWidth
    ScrHght%=gHeight
    LOADM "z:\system\opl\Toolbar"
    TBarLink:("_main")            Rem 'links' toolbar globals and then calls _main
ENDP

Rem PROC ALLOC&:(size&,name$)
Rem wrapper for ALLOC such that memory leaks and debugging can be
Rem performed as well as finding where memory leaks are
Rem LOCAL p&
Rem    p&=ALLOC(size&+20+4)
Rem    Rem pointer to next, member number, name$ pointer, length,
Rem    Rem 4-byte-check, ALLOC, 4-byte check
Rem    IF p&=0
Rem NoMem::
Rem        PRINT "OUT OF MEMORY"
Rem        GET
Rem        STOP
Rem    ENDIF
Rem    IF _palloc&=0
Rem        _palloc&=ADDR(_alloc&)
Rem    ENDIF
Rem    POKEL _palloc&,p&
Rem    _palloc&=p&
Rem    POKEL p&,0                            Rem next
Rem    POKEL p&+4,_nalloc&    Rem counter
Rem    POKEL p&+8,ALLOC((LEN(name$)+16) AND $FFF0)
Rem    IF PEEKL(p&+8)=0
Rem        GOTO NoMem::
Rem    ENDIF
Rem    POKE$ PEEKL(p&+8),name$
Rem    POKEL p&+12,size&
Rem    POKEL p&+16,NOT _nalloc&        Rem check for overflows
Rem    POKEL p&+size&+20,NOT _nalloc&        Rem check for overflows
Rem    _talloc&=_talloc&+1
Rem    IF varMemDebug%>1
Rem        PRINT p&,_alloc&,_palloc&,_nalloc&,"Allocated",size&,"bytes, procedure:",name$,"Total:",
Rem    ENDIF
Rem    IF varMemDebug%
Rem        PRINT "[";_talloc&;"]",
Rem        IF varMemDebug%>1
Rem            PRINT
Rem        ENDIF
Rem    ENDIF
Rem    _nalloc&=_nalloc&+1
Rem    RETURN p&+20        Rem start of block that can be used
Rem ENDP

Rem PROC FREEALLOC&:(addr&)
Rem wrapper for FREEALLOC. Check elements in _alloc& structure for
Rem one matching addr&
Rem LOCAL p&,q&,n&
Rem    p&=ADDR(_alloc&)
Rem    IF varMemDebug%>1
Rem        PRINT "Checking for",addr&,"in",
Rem    ENDIF
Rem    WHILE PEEKL(p&)
Rem        q&=p&
Rem        p&=PEEKL(p&)
Rem        IF varMemDebug%>1
Rem            PRINT p&,
Rem        ENDIF
Rem        IF p&+20=addr&
Rem            IF varMemDebug%>1
Rem                PRINT "Found it!!!!",PEEKL(p&+4),PEEK$(PEEKL(p&+8)),"Length",PEEKL(p&+12),
Rem            ENDIF
Rem            n&=PEEKL(p&+4)        Rem number
Rem            IF PEEKL(p&+16) <> NOT n&
Rem                PRINT PEEK$(PEEKL(p&+8)),"ERROR: corruption at start"
Rem            ELSEIF PEEKL(p&+20+PEEKL(p&+12)) <> NOT n&
Rem                PRINT PEEK$(PEEKL(p&+8)),"ERROR: corruption at end"
Rem            ENDIF
Rem            FREEALLOC(PEEKL(p&+8))            Rem name$
Rem            POKEL q&,PEEKL(p&)                    Rem patch structure
Rem            IF PEEKL(p&)=0        Rem last
Rem                _palloc&=q&
Rem            ENDIF
Rem            FREEALLOC(p&)                                Rem free rest of struture
Rem            _talloc&=_talloc&-1
Rem            IF varMemDebug%
Rem                PRINT "[";_talloc&;"]",
Rem                IF varMemDebug%>1
Rem                    PRINT
Rem                ENDIF
Rem            ENDIF
Rem            p&=0
Rem            BREAK
Rem        ENDIF
Rem    ENDWH
Rem    IF p&
Rem        PRINT p&,"ERROR: NOT found!!!!"
Rem        GET
Rem    ENDIF
Rem ENDP

PROC _main:
REM Continue from toolbar link TBarLink:
GLOBAL _stat%,_key%(2)            Rem for KEYA Esc key...
GLOBAL _spec$(19)
GLOBAL _bltin$(NBUILTIN%,7)
GLOBAL _curr&                    Rem address of current argument block
GLOBAL _pid%                        Rem current subshell counter
GLOBAL _hash&                    Rem base of hashed path list
GLOBAL _dirB&,_dirC&
GLOBAL _atab&
GLOBAL _cwd$(255)
GLOBAL _hpos&,_hnum%,_hsz%,_hrsz%
GLOBAL _cpos&                    Rem this allows set, etc to reset the position in the
                                                Rem history list for getin$
GLOBAL ScrInfo%(10)
GLOBAL _opts%(5)
GLOBAL _opts$(38)                Rem EXACT max size when all variables are set
Rem GLOBAL varUNIX%,varApp%,varEcho%,varStyl%
GLOBAL _out%                        Rem handle for redirected output
GLOBAL _in%                        Rem handle for redirected/piped input
GLOBAL argv&(128)
GLOBAL _vars&
GLOBAL _keys&                    Rem address of key table (512 bytes)
GLOBAL _syspath$(255)        Rem location of files, e.g. pipes
GLOBAL _here$(64)                Rem flag and string to search for in "here"
                                                Rem    redirection (<< here$)
GLOBAL _logid%,_logw%,_logh%
GLOBAL _logs&                    Rem base of log entry structure
GLOBAL _logn%                    Rem current "end viewing postion" in the log
GLOBAL _logl%                    Rem current end position in SHlogs%
GLOBAL _extevent%            Rem used to indicate buttons, etc.
GLOBAL _pushc&                Rem current location in pushd table
GLOBAL _help&                    Rem base of linked list of open help files
GLOBAL _sndstat&                Rem sound status word
GLOBAL _style%                    Rem text window current style!!
GLOBAL _act$(13,12)            Rem names of 13 key operations
Rem GLOBAL _alloc&            Rem debug alloc list
Rem GLOBAL _nalloc&        Rem counter for debug alloc
Rem GLOBAL _palloc&        Rem current last element
Rem GLOBAL _talloc&        Rem current number of heap entities
Rem GLOBAL varMemDebug%
LOCAL line$(255),p&,q&
Rem main loop
    ONERR ErrTrap::
    _init:    Rem initialize things...
    DO
        DO
            line$=_getin$:(_mkpr$:(GetVar$:("prompt")))
        UNTIL LEN(line$)
        IF PEEKL(_hpos&+8)        Rem Data part is used so free first
            FREEALLOC(PEEKL(_hpos&+8))
Rem            FREEALLOC&:(PEEKL(_hpos&+8))
        ENDIF
        POKEL _hpos&+8,ALLOC((LEN(line$)+16) AND $FFF0)
Rem        POKEL _hpos&+8,ALLOC&:((LEN(line$)+16) AND $FFF0,"main1")
Rem size = 1 for size of string, 15 to ensure minimum memory is allocated
        IF PEEKL(_hpos&+8)=0
            RAISE -10
        ENDIF
        POKE$ PEEKL(_hpos&+8),line$
        IF _hsz% > _hrsz%
        Rem history is set larger than it currently is, so allocate another member
            p&=_hpos&
            q&=PEEKL(p&)
            POKEL p&,ALLOC(16)        Rem 12, but rounded to 16 to avoid fragmentation
Rem            POKEL p&,ALLOC&:(16,"main2")        Rem 12, but rounded to 16 to avoid fragmentation
            _hpos&=PEEKL(p&)
            IF _hpos&=0
                RAISE -10
            ENDIF
            POKEL _hpos&,q&        Rem glue 'next'
            POKEL _hpos&+4,p&    Rem glue 'previous'
            POKEL _hpos&+8,0
            POKEL q&+4,_hpos&        Rem glue reference
            _hrsz%=_hrsz%+1
        ELSE
            _hpos&=PEEKL(_hpos&)
        ENDIF
        POKEB _curr&+PR_FLAG%,0        Rem reset exit flag
        _proc%:(line$)
        _hnum%=_hnum%+1
    UNTIL PEEKB(_curr&+PR_FLAG%)        Rem until exit!
Rem    PRINT "Exiting, status",PEEKB(_curr&+PR_FLAG%)
    _exit:            Rem clean up and never return
ErrTrap::
    ONERR off
    PRINT "Fatal:",errx$,err$:(ERR)
    GET
ENDP

PROC _store%:(addr&,store%,pa&)
Rem pa& is the proc structure to use, could be globals!
LOCAL v%,e%,out$(255),f%,p&,buf$(255),n%,attr%(8),ret%,oldn%
    f%=PEEKW(addr&)
    out$=PEEK$(addr&+7)
Rem    PRINT f%,out$,pa&
    IF f% AND $40
        f%=f% AND $FFBF    Rem clear var flag
        v%=PEEKW(addr&+2)
        IF v% <> LEN(out$)    Rem ignore a$, $
            buf$=RIGHT$(out$,LEN(out$)-v%)
            out$=LEFT$(out$,v%)
            IF LEN(buf$)=1    Rem $x
Rem                PRINT "One character lookup:",buf$
                n%=ASC(buf$)
                p&=PEEKL(pa&+PR_BACK%)    Rem parent args
                IF n%=%?
                    buf$=NUM$(PEEKW(p&+PR_STATUS%),5)
Rem                    PRINT "Got $?, status, returning",buf$,PEEKW(p&+PR_STATUS%),p&+PR_STATUS%
                    GOTO Floozy::
                ELSEIF n%=%#
                    Rem parent args-1
                    buf$=NUM$(PEEKB(p&)-PEEKB(p&+PR_OFFSET%)-1,5)
Rem                    PRINT "Got $#, no of args, returning",buf$
                    GOTO Floozy::
                ELSEIF n%>=%0 AND n%<=%9
Rem                    PRINT "Got $";CHR$(n%)
                    n%=n%-%0    Rem get number 0-9
Rem                    PRINT "n% is:",n%
                    IF n%            Rem 1-9
Rem                        PRINT "$1 to $9"
                        n%=n%+PEEKB(p&+PR_OFFSET%)
                        Rem don't shift in $0 OR have n% > no of args
                        IF n%>=PEEKB(p&)
Rem                            PRINT "Out of range"
                            GOTO DoNowt::
                        ENDIF
                    ENDIF
                    buf$=PEEK$(PEEKL(p&+4*n%+PR_ARGV%))
Rem                PRINT p&,n%,buf$
Floozy::        out$=out$+buf$
                    GOTO DoNowt::
                ENDIF
            ENDIF
            p&=PEEKL(_vars&)
            WHILE p&
                IF PEEK$(PEEKL(p&+4))=buf$
                    out$=out$+PEEK$(PEEKL(p&+8))
                    BREAK
                ENDIF
                p&=PEEKL(p&)
            ENDWH
DoNowt::
            POKEW addr&+2,0    Rem clear v%
        ENDIF
    ENDIF
    IF (f% AND $81) = $81    Rem ${ completed (} resets flag)
        e%=PEEKW(addr&+4)
        IF e%<>LEN(out$)    Rem ${..} isn't empty
            out$=LEFT$(out$,e%)+GEN$(EVAL(RIGHT$(out$,LEN(out$)-e%)),20)
        ENDIF
        f%=f% AND $FF7E
        POKEW addr&+4,0    Rem clear e%
    ENDIF
    IF store%
        IF f% AND $F00    Rem check for redirection
            IF f% AND $20    Rem operator
Rem                PRINT "Debug: Trying to redirect on an operator"
                RAISE 10
            ENDIF
            IF f% AND $800    Rem Here doc (<<)
                _here$=out$
                IF PEEKB(pa&+PR_LEV%)=%1
                    POKEB pa&+PR_LEV%,%2
                ELSE
                    POKEB pa&+PR_LEV%,%1
                ENDIF
                out$=_syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe."+CHR$(PEEKB(pa&+PR_LEV%))
Rem set filename to write "here"
Rem    to and for the command to get it's input from
            ENDIF
            ret%=Fparse%:(ADDR(buf$),out$)    Rem parse filename
            IF ret%<0    AND ret%<>-33
                RAISE ret%    Rem any error except file doesn't exist
            ENDIF
            IF f% AND $300    Rem either redirect replace or append
Rem check for existing redirection
                IF PEEKW(pa&+PR_OUT%)
                    GOTO Tidy::    Rem forget it!!!!
                ENDIF
                IF (f% AND $200) OR (_opts%(varAppend%))    Rem append, not replace?
Rem Append to file, or append to flag is set
                    ret%=IOOPEN(#pa&+PR_OUT%,buf$,$0123)
                    IF ret%=-33    Rem file doesn't exist
Create::            ret%=IOOPEN(#pa&+PR_OUT%,buf$,$0122)
                    ENDIF
                    IF ret%                Rem file doesn't exist
                        RAISE ret%
                    ENDIF
                ELSE
                    GOTO Create::
                ENDIF
            ELSE                    Rem input redirection ($400 or $800)
                IF PEEKW(pa&+PR_IN%)            Rem check for existing redirection
                    GOTO Tidy::    Rem forget it!!!!
                ENDIF
                IF f% AND $400    Rem normal input redirection
                    ret%=$0120
                ELSE    Rem << redirection
                    ret%=$0322    Rem create, random access for seek
                ENDIF
                    ret%=IOOPEN(#pa&+PR_IN%,buf$,ret%)
                IF ret%
                    RAISE ret%
                ENDIF
            ENDIF
Tidy::    f%=f% AND $F0FF    Rem clear flag
            GOTO Skip::
        ENDIF
        IF f% AND $20    Rem operator
            IF out$=">"
                f%=f% OR $100
                GOTO skip::
            ELSEIF out$=">>"
                f%=f% OR $200
                GOTO skip::
            ELSEIF out$="<"
                f%=f% OR $400
                GOTO skip::
            ELSEIF out$="<<"
                f%=f% OR $800
                GOTO skip::
            ENDIF
        ENDIF    Rem not a redirection operator, store it
        n%=PEEKB(pa&)    Rem number of arguments
        IF f% AND $10    Rem wildcard
            parse%:(out$,ADDR(buf$),ADDR(attr%()))
            buf$=DIR$(buf$)
            IF LEN(buf$)=0
                RAISE 4        Rem flag null wildcard
            ENDIF
            oldn%=n%        Rem store old value of n%
            WHILE LEN(buf$)
                IF n%>=PEEKB(pa&+PR_ARGN%)
                    RAISE -6    Rem overflow
                ENDIF
                p&=pa&+PR_ARGV%+n%*4
                POKEL p&, ALLOC((LEN(buf$)+16) AND $FFF0)
Rem                POKEL p&, ALLOC&:((LEN(buf$)+16) AND $FFF0,"store1")
                IF PEEKL(p&)=0    Rem no memory
                    RAISE -10
                ENDIF
                n%=n%+1
                POKE$ PEEKL(p&),PrPath$:(buf$)
                buf$=DIR$("")
            ENDWH
            IF oldn%=0 AND n%>1    Rem this was the first argument
                                            Rem and there's more than 1 match
                RAISE 11    Rem not unique so fail it!
            ENDIF
        ELSE    Rem not wildcards
            IF n%>=PEEKB(pa&+PR_ARGN%)
                RAISE -6    Rem overflow
            ENDIF
            p&=pa&+PR_ARGV%+n%*4
            POKEL p&, ALLOC((LEN(out$)+16) AND $FFF0)
Rem            POKEL p&, ALLOC&:((LEN(out$)+16) AND $FFF0,"store2")
Rem            PRINT "Storing",out$,n%,pa&,"at",p&,PEEKL(p&)
            IF PEEKL(p&)=0    Rem no memory
                RAISE -10
            ENDIF
            n%=n%+1
            POKE$ PEEKL(p&),out$
        ENDIF
        POKEB pa&,n%    Rem store no. of arguments
Skip::
        f%=f% AND $FFC7    Rem clear wild,store and special flag
        out$=""
    ENDIF
    POKEW(addr&),f%
    POKE$ addr&+7,out$
ENDP

PROC fprint%:(p$)
LOCAL ret%,buf$(255)
    IF _out%
        buf$=p$+CHR$(13)            Rem for 0x0D 0x0A
        ret%=IOWRITE(_out%,ADDR(buf$)+1,LEN(buf$))
        IF ret%
            RAISE ret%    Rem any error here MUST be fatal
        ENDIF
    ELSE
        PRINT p$
    ENDIF
ENDP

PROC _clrA:(pa&)    Rem close redirection file and unallocate arg. heap
LOCAL i%
    IF PEEKW(pa&+PR_OUT%)
        IOCLOSE(PEEKW(pa&+PR_OUT%))
        POKEW(pa&+PR_OUT%),0
    ENDIF
    IF PEEKW(pa&+PR_IN%)
        IOCLOSE(PEEKW(pa&+PR_IN%))
        POKEW(pa&+PR_IN%),0
    ENDIF
    i%=PEEKB(pa&)*4    Rem number of stored arguments
    WHILE i%
        i%=i%-4
Rem        PRINT "Freeing:",pa&+PR_ARGV%+i%,PEEKL(pa&+PR_ARGV%+i%),PEEK$(PEEKL(pa&+PR_ARGV%+i%))
        FREEALLOC PEEKL(pa&+PR_ARGV%+i%)
Rem        FREEALLOC&:(PEEKL(pa&+PR_ARGV%+i%))
    ENDWH
    POKEB pa&,0    Rem set no arguments
ENDP

PROC _inpar%:(in$,pa&,spec$)
REM parse the input, creating the argv& structure and return thr
REM number of arguments in n%
LOCAL i%,len%,c$(1),p%,ret%,handle%
LOCAL flag%,varpos%,evalpos%,out$(255)    Rem KEEP THESE TOGETHER
Rem flag%:
Rem Bit 0 - set if we're in a $(...)
Rem Bit 1 - set if we're in a '...'
Rem Bit 2 - set if we're in a "..."
Rem Bit 3 - set if we're storing something
Rem Bit 4 - set if we have a wildcard
Rem Bit 5 - set if we're storing an operator
Rem Bit 6 - set if we're in a variable
Rem Bit 7 - set when ${..} terminates
Rem Bit 8 - set if output redirection
Rem Bit 9 - set if output redirection + appending
Rem Bit 10 - set if input redirection
Rem Bit 11 - set if here document, ie. <<
    POKEB pa&+PR_OFFSET%,0            Rem initialize shift offset
    len%=LEN(in$)
    WHILE i%<len%
        i%=i%+1
        c$=MID$(in$,i%,1)
        p%=LOC(spec$,c$)
Rem        PRINT c$,p%,flag%
        VECTOR p%
            Spc,Dbl,Sgl,Wld,Wld,OpB,ClB,Spl,Spl,Spl,Op,Op,Op,Com,Semi,Pipe,Spl,Vbl
        ENDV
        GOTO Nullp    Rem no-op
Spc::    Rem space
        IF (flag% AND $E) = 8    Rem store, not in quotes
            IF flag% AND $1
                IF flag% AND $40        Rem ${..$var..}
                    _store%:(ADDR(flag%),0,pa&)
                Rem COULD put an ELSE out$=out$+c$
                ENDIF
            ELSE    Rem normal variable or word
                _store%:(ADDR(flag%),1,pa&)
            ENDIF
        ELSEIF flag% AND 6    Rem any quote, 7 to save spaces in ${}
            out$=out$+c$
        ENDIF
        CONTINUE
Vbl::    Rem $ (OR %)
        IF (flag% AND 6)=0    Rem not in ' or "
            IF (flag% AND $40)    Rem already storing
                _store%:(ADDR(flag%),0,pa&)
            ELSE
                IF (flag% AND $21)=$20    Rem was a special, not in ${}
                    _store%:(ADDR(flag%),1,pa&)
                ENDIF
                varpos%=LEN(out$)
                flag%=flag% OR $48
            ENDIF
            CONTINUE
        ENDIF
        GOTO Nullp::
Dbl::    IF flag% AND $02        Rem ", check for '
            out$=out$+c$        Rem just store it normally
        ELSEIF flag% AND $04    Rem Already "?
            flag%=flag% AND $FFFB
        ELSE
            IF flag% AND $40    Rem were storing a variable
                _store%:(ADDR(flag%),0,pa&)
            ELSEIF flag% AND $20    Rem operator
                _store%:(ADDR(flag%),1,pa&)
            ENDIF
            flag%=flag% OR $0C
        ENDIF
        CONTINUE
Sgl::    IF flag% AND $04    REM "
            out$=out$+c$    Rem just store it normally
        ELSEIF flag% AND $02    Rem Already '?
            flag%=flag% AND $FFFD
        ELSE
            IF flag% AND $40    Rem were storing a variable
                _store%:(ADDR(flag%),0,pa&)
            ELSEIF flag% AND $20    Rem operator
                _store%:(ADDR(flag%),1,pa&)
            ENDIF
            flag%=flag% OR $0A
        ENDIF
        CONTINUE
Wld::
        IF flag% AND $1    Rem ${..} so not a wildcard but a special
            GOTO spl::
        ELSEIF (flag% AND $46) = 0    Rem not quoted OR a variable
            flag%=flag% OR $10    Rem flag wildcard
        ENDIF
        Rem fall through to normal processing
        GOTO Nullp::
OpB::
        IF (flag% AND $6)=0    Rem not quoted
            IF LEN(out$)=varpos% AND (flag% AND $40)
                Rem Found ${
                IF flag% AND 1    Rem already storing a ${..}
                    RAISE 8
                ENDIF
                flag%=flag% AND $FFBF OR $1
Rem                varpos%=0    Rem necessary?
                evalpos%=LEN(out$)
                CONTINUE
            ENDIF
        ENDIF
        GOTO Nullp::    Rem NOT ${ or already in one or quoted
ClB::    IF (flag% AND $7)=1    Rem In ${..}, NOT quoted
Rem    IF (flag% AND $6)=0    Rem NOT quoted
Rem            IF flag% AND $1
                flag%=flag% OR $80            Rem flag store evaluate
                _store%:(ADDR(flag%),0,pa&)
                flag%=flag% AND $FFFE        Rem clear ${..}
                CONTINUE
Rem            ENDIF
        ENDIF
        GOTO Nullp::
Spl::    IF (flag% AND $26)=0    Rem not in the middle of one
            IF flag% AND 1    Rem in ${..}
                IF flag% AND $40    Rem variable store in ${..}
                    _store%:(ADDR(flag%),0,pa&)
                ENDIF
            ELSE
                IF flag% AND 8    Rem normal store
                    _store%:(ADDR(flag%),1,pa&)
                ENDIF
                flag%=flag% OR $28    Rem flag special & store
            ENDIF
        ENDIF
        out$=out$+c$    Rem store it...
        CONTINUE
Semi::    Rem semi-colon
        IF flag% AND $7    Rem only allow semi-colon out of ',",${..}
            GOTO Nullp
        ELSE
            POKEB pa&+PR_INPST%,1    Rem flag multi-commands per line
            POKEB pa&+PR_INPPS%,i%    Rem mark current position
            BREAK
        ENDIF
Pipe::    Rem pipe
        IF flag% AND $7    Rem only allow pipes out of ',",${..}
            GOTO Nullp
        ELSE
            POKEB pa&+PR_INPST%,2    Rem flag pipe per line
            Rem ALWAYS create _syspath$\pipe.x
            Rem    - why??? - so that the next command in the pipe
            Rem    has something to open!!
            IF PEEKB(pa&+PR_LEV%)=%1
                POKEB pa&+PR_LEV%,%2
            ELSE
                POKEB pa&+PR_LEV%,%1
            ENDIF
Rem            PRINT _syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe."+CHR$(PEEKB(pa&+PR_LEV%))
            ret%=IOOPEN(handle%,_syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe."+CHR$(PEEKB(pa&+PR_LEV%)),$0122)
            IF ret%
                RAISE ret%
            ENDIF
            IF PEEKW(pa&+PR_OUT%) OR (flag% AND $300)
Rem Already redirected or in the middle of one
                IOCLOSE(handle%)
            ELSE
                POKEW pa&+PR_OUT%,handle%
            ENDIF
            POKEB pa&+PR_INPPS%,i%    Rem mark current position
            BREAK
        ENDIF
Com::    Rem comment char #, valid at start of token
        IF flag%    Rem only allow comments if in white space
            GOTO Nullp
        ELSE
            BREAK
        ENDIF
Op::    Rem +,- or /, only treat as special within ${..}
        IF flag% AND 1
            GOTO spl::
        ENDIF
        Rem drop through
NullP::
        IF (flag% AND $6F) = 0    Rem no flags set
            flag%=flag% OR $8        Rem start the store
        ELSEIF (flag% AND $21)=$20    Rem were in <>= but NOT ${..}
            _store%:(ADDR(flag%),1,pa&)
            flag%=flag%  OR $8    Rem start the store
        ENDIF
        out$=out$+c$    Rem store it...
    ENDWH
    IF (flag% AND $F08F)=8    Rem ignore wildycards, <>= and variables
        _store%:(ADDR(flag%),1,pa&)
    ELSEIF flag% AND $FFEF    Rem fail for ' " and ${..}
        IF flag% AND $1
            RAISE 8
        ELSEIF flag% AND $2
            RAISE 7
        ELSEIF flag% AND $4
            RAISE -70
        ENDIF
    ENDIF
    IF flag% AND $800    Rem any of the redirection flags bits 8-10
Rem        PRINT "Debug: redirection isn't complete and we're finished"
        RAISE 10
    ENDIF
    RETURN PEEKB(pa&)    Rem return number of arguments
ENDP

PROC _subpr%:(pa&)
Rem From the data in argv%, find output redirection, and
Rem process according to argv&(1)
LOCAL i%,ret%,narg%
LOCAL buf$(255)
    narg%=PEEKB(pa&)
    IF narg%    Rem may be 0 after redirection
        Rem copy pa& to argv&!!!
        i%=PEEKB(pa&)*4        Rem number of items to copy
        WHILE i%
            i%=i%-4
Rem            PRINT "Copying",i%,PEEK$(PEEKL(pa&+i%+PR_ARGV%))
            POKEL ADDR(argv&())+i%,PEEKL(pa&+i%+PR_ARGV%)
        ENDWH
        _in%=PEEKW(pa&+PR_IN%)
        _out%=PEEKW(pa&+PR_OUT%)
        i%=NBUILTIN%
        buf$=LOWER$(PEEK$(PEEKL(pa&+PR_ARGV%)))    Rem 1st arg
        WHILE i%
            IF _bltin$(i%)=buf$
                BREAK
            ENDIF
            i%=i%-1
        ENDWH
        IF i%
            ret%=@%(_bltin$(i%)):(narg%)
        ELSE    Rem check buf$ in path, absolute file, OPO, OPA, BAT
            ret%=_chkp%:(buf$,narg%)    Rem or directory
        ENDIF
    ENDIF
    RETURN ret%
ENDP

PROC _chkp%:(in$,n%)
LOCAL buf$(255),attr%(8),ret%,i%,ext$(255),load%,pid%,buf2$(255),k&
LOCAL arg$(255),m%,code%,h%,Uid2&,p&,mode%
    ONERR ErrTrap::
    IF _opts%(varUNIXpath%)
        i%=LOC(in$,"/")
    ELSE
        i%=LOC(in$,"\")
    ENDIF
    IF i% OR LOC(in$,":")    Rem absolute pathname (: or filename separator)
Rem        PRINT "Searching for an absolute path",buf$
        ret%=parse%:(in$,ADDR(buf$),ADDR(attr%()))
        IF ret%<0
            RAISE ret%
        ENDIF
        ret%=stat%:(ADDR(buf$))        Rem REALLY check if it exists
        IF LEN(buf$)>attr%(5)    Rem extension
            IF ret%>=0    Rem file/directory exists
                IF (ret% AND 16)=0            Rem a files
                    ext$=LOWER$(RIGHT$(buf$,LEN(buf$)-attr%(5)))
                    IF ext$<>"opo" AND ext$<>"bat" AND ext$<>"app"
Rem                        PRINT "Bad extension"
                        GOTO NotFnd::
                    ELSE
Rem                        PRINT "Running",buf$,"extension",ext$
                        GOTO Run::
                    ENDIF
                ELSE
Rem                    buf$=buf$+"\"
                    GOTO Direct::
                ENDIF
            ELSE
                GOTO NotFnd::
            ENDIF
        ELSE
Rem    No extension
Rem ignore a file of the correct name without an extension
Rem because without an extension we don't know it's type...
Rem            PRINT "No extension"
            IF (ret%>=0) AND  ((ret% AND 16)=16)
                i%=1    Rem flag it's a directory
            ELSE
                i%=0
            ENDIF
            arg$="bat,opo,app,"
            WHILE LEN(arg$)
                m%=LOC(arg$,",")
                buf2$=buf$+"."+LEFT$(arg$,m%-1)
                ret%=stat%:(ADDR(buf2$))
                IF (ret%>=0) AND ((ret% AND 16)=0)    Rem File
                    buf$=buf2$
                    GOTO Run::
                ENDIF
                arg$=RIGHT$(arg$,LEN(arg$)-m%)
            ENDWH
            IF i%    Rem it's a directory
                GOTO Direct::
            ELSE
                GOTO NotFnd::
            ENDIF
        ENDIF
    ELSE
Rem currently in$ is lower case - use UPPER$(in$) to change
Rem        PRINT "Should look",in$,"in hash table here"
        buf$=_hshf$:(in$)    Rem look for in$ in the hash table
    ENDIF
    IF LEN(buf$)
        GOTO Run::
    ENDIF
    ret%=Fparse%:(ADDR(buf$),in$)
    IF (ret%>=0) AND ((ret% AND 16)=16)    Rem directory
        GOTO Direct::
    ELSE
        GOTO NotFnd::
    ENDIF
    RETURN
Direct::
    _cd%:(buf$)
    RETURN
Run::
    ext$=LOWER$(RIGHT$(buf$,3))
Rem    PRINT "Want to run",buf$
    IF ext$="opo"
        LOADM buf$
Rem necessary to get the attr% information to extract the command
Rem name == the procedure name
        ret%=parse%:(buf$,ADDR(buf$),ADDR(attr%()))
        ONERR LoadErr::    Rem special trap handler that will goto RunOpp if
Rem the .OPO file doesn't look like a shell 3a module - procedure NOT
Rem found (-99) or Wrong number of arguments (-97)
        load%=1
Rem execute the command
        code%=@%(MID$(buf$,attr%(4),attr%(5)-attr%(4))):(n%)
        load%=0
        ONERR ErrTrap::    Rem return to normal error trapping
        UNLOADM buf$
    ELSEIF ext$="bat"
        IF _in% OR _out%     Rem in a pipe or input/output redirection
            RAISE 5
        ENDIF
        code%=_run%:(buf$)
    ELSEIF ext$="app"        Rem check whether it's an OPL application
Rem buf$ contains the full pathname, it exists and is a file
        ret%=IOOPEN(h%,buf$,$0400)            Rem open existing file
        IF ret%
            RAISE ret%
        ENDIF
        p&=ADDR(buf2$)
        ret%=IOREAD(h%,p&+1,16)                    Rem read first 16 bytes
        IOCLOSE(h%)
        IF ret%<0                    Rem this includes short reads...
            IF ret%=-36            Rem EOF
                GOTO BadApp::
            ENDIF
            RAISE ret%
        ELSE
            POKEB p&,16                Rem length of string
            Uid2&=PEEKL(p&+5)    Rem the Uid we're actually interested in
            IF buf2$<>CheckUid$:(PEEKL(p&+1),Uid2&,PEEKL(p&+9))
BadApp::
                PRINT "Not a valid application"
                GOTO End::
            ENDIF
        ENDIF
Rem check if we've more arguments and whether files specified exist
Rem An enhancement would be to check do type vs. application type
Rem  but for the moment we'll keep it simple.
        mode%=2                Rem default to "run"
        IF n%>1                    Rem arguments to program
            ret%=Fparse%:(ADDR(buf2$),PEEK$(argv&(2)))
            IF ret%<0
                IF ret%=-33                Rem file doesn't exist
                    mode%=1                Rem create
                ELSE
                    RAISE ret%
                ENDIF
            ELSEIF ret%
                RAISE -7
            ELSE
                mode%=0                    Rem file exists
            ENDIF
        ENDIF
        IF Uid2&=KUidOplApp&
Rem            PRINT "Running as OPL"
            GOTO RunOPL::
        ELSE
Rem            PRINT "Running as stand-alone",buf$,buf2$,mode%
            RunApp&:(buf$,buf2$,"",mode%)
        ENDIF
    ENDIF
    GOTO End::
LoadErr::                                            Rem error on running LOADM'd module
    ONERR off
    IF load%                        Rem error during execution - MUST unload module
        UNLOADM buf$
        load%=0
    ENDIF
    IF ERR=-97 OR ERR=-99    Rem .opo wasn't a shell3a module - exec instead
Rem        PRINT "DEBUG,Module not for Shell5, executing as normal .OPO module"
        ONERR ErrTrap::
        buf2$=""        Rem arguments
        mode%=2    Rem run mode in "run", ie. no arguments
RunOPL::
        code%=RUNAPP&:("OPL",buf2$,"R"+buf$,mode%)
    ELSE
        GOTO ErrTrap::    Rem otherwise some other OPO error
    ENDIF
End::
    RETURN code%
NotFnd::
    PRINT "Command not found"
    RETURN            Rem nothing has been run, so no error!??
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR            Rem is this correct??
ENDP

PROC _hshf$:(in$)
Rem The input MUST be     (with/out) an extension
Rem Outputs an empty string or the found/stored pathname
LOCAL ret%,p&,q&,buf$(255),ext$(255),res$(255),f%
    ret%=LOC(in$,".")    Rem look for extension
    IF ret%    Rem one exists
        ext$=LOWER$(RIGHT$(in$,LEN(in$)-ret%))
        IF ext$<>"opo" AND ext$<>"bat" AND ext$<>"app"
Rem            PRINT "Bad extension"
            RETURN
        ENDIF
        buf$=LEFT$(in$,ret%-1)
        f%=1    Rem flag that we've a supplied extension
    ELSE
        buf$=in$
        ext$="bat,opo,app"
    ENDIF
Rem    PRINT "Looking for",buf$
    Rem buf$ is in$ without the extension
    p&=_hash&
    WHILE PEEKL(p&)
        q&=p&    Rem previous item
        p&=PEEKL(p&)
Rem always do the checks in lower case
        res$=LOWER$(PEEK$(p&+4))
        IF f%    Rem SUPPLIED extension
            IF res$=in$
                GOTO Found::
            ENDIF
        ELSE    Rem ANY extension
            IF buf$=LEFT$(res$,LEN(res$)-4)
Found::    Rem MUST preserve buf$ - path uses it later
                res$=PEEK$(p&+LEN(res$)+5)
                ret%=Fparse%:(ADDR(res$),res$)
                Rem check if the hashed file exists
                IF (ret%>=0) AND ((ret% AND 16)=0)    Rem file
Rem                    PRINT "Found",res$
                    RETURN res$
                ELSE    Rem not a file so remove from the hash table
                    POKEL q&,PEEKL(p&)
                    FREEALLOC(p&)
Rem                    FREEALLOC&:(p&)
                    p&=q&    Rem set current record=last
                ENDIF
            ENDIF
        ENDIF
    ENDWH
    Rem not in the hash table
    res$=_path$:(GetVar$:("path"),buf$,ext$)
    IF LEN(res$)    Rem found
Rem        PRINT "Storing:",buf$;".";RIGHT$(res$,3),"as",res$
        Rem add to PATH, p% already is the last HASH element
        Rem pointer(4), name, extension (4), +1, path +1,+16
        POKEL p&,ALLOC((LEN(buf$)+LEN(res$)+26) AND $FFF0)
Rem        POKEL p&,ALLOC&:((LEN(buf$)+LEN(res$)+26) AND $FFF0,"hshf1")
        p&=PEEKL(p&)
        IF p&=0
            RAISE -10
        ENDIF
        POKEL p&,0
        POKE$ p&+4,buf$+RIGHT$(res$,4)
        POKE$ p&+LEN(buf$)+9,res$
        RETURN res$
    ENDIF
ENDP

PROC _path$:(path$,file$,ext$)
Rem path$ is the path to search in
Rem file$ is the filename to search for
Rem ext$ is a , separated list of extensions to look for
Rem  and it returns the first occurance or ""
LOCAL p$(255),n%,m%,ep$(255),ret%,buf$(255),buf2$(255)    Rem ,attr%(8)
Rem    PRINT "Searching for",file$,"in",path$,"with extensions",ext$
    p$=path$+","    Rem ensure a terminating ,
    WHILE LEN(p$)
        n%=LOC(p$,",")
Rem        ret%=parse%:(LEFT$(p$,n%-1),ADDR(buf$),ADDR(attr%()))
Rem        IF ret%<0
Rem            GOTO Bad::    Rem bad component
Rem        ENDIF
Rem        ret%=stat%:(ADDR(buf$))
        ret%=Fparse%:(ADDR(buf$),LEFT$(p$,n%-1))
        IF (ret%<0) OR ((ret% AND 16)=0)    Rem Not directory
Rem Bad::
Rem    IF file$<>"autoexec"    Rem don't flag path errors for this
            _log:(3,"Bad path component:  "+LEFT$(p$,n%-1))
Rem                PRINT "Bad path component:  "+LEFT$(p$,n%-1)
Rem            ENDIF
        ELSE
            buf$=buf$+file$+"."
            ep$=ext$+","    Rem ensure terminating ,
            WHILE LEN(ep$)
                m%=LOC(ep$,",")
                buf2$=buf$+LEFT$(ep$,m%-1)
                ret%=stat%:(ADDR(buf2$))
                IF (ret%>=0) AND ((ret% AND 16)=0)    Rem Not directory
                    RETURN buf2$
                ENDIF
                ep$=RIGHT$(ep$,LEN(ep$)-m%)
            ENDWH
        ENDIF
        p$=RIGHT$(p$,LEN(p$)-n%)
    ENDWH
    RETURN
ENDP

PROC PrPath$:(p$)
LOCAL q$(255),i%
    q$=p$
    IF _opts%(varUNIXpath%)
        DO
            i%=LOC(q$,"\")
            IF i%=0
                BREAK
            ENDIF
            q$=LEFT$(q$,i%-1)+"/"+RIGHT$(q$,LEN(q$)-i%)
        UNTIL 0
    ENDIF
    RETURN q$
ENDP

PROC parse%:(i$,retstr&,addr&)
LOCAL out$(255),store$(255),c$(1)
LOCAL len%,p&,i%,off%,in$(255)
    ONERR ErrTrap::
    in$=i$
    IF _opts%(varUNIXpath%)
        DO
            i%=LOC(in$,"/")
            IF i%=0
                BREAK
            ENDIF
            in$=LEFT$(in$,i%-1)+"\"+RIGHT$(in$,LEN(in$)-i%)
        UNTIL 0
    ENDIF
    len%=LEN(in$)    Rem length of input to be parsed
    off%=1                    Rem offset within input
    p&=PEEKL(_dirB&)
    IF len%>1            Rem COULD be x:
        IF MID$(in$,2,1)=":"
            len%=len%-2
            off%=off%+2
Rem check if this device exists
            WHILE p&
                IF LEFT$(PEEK$(p&+4),2)=UPPER$(LEFT$(in$,2))        Rem compare device parts
                    out$=LEFT$(PEEK$(p&+4),2)        Rem store this part
                    GOTO Found::
                ENDIF
                p&=PEEKL(p&)
            ENDWH
            RAISE -41    Rem no such device
        ENDIF
    ENDIF
Rem We haven't a supplied node, so get the node from the curr dir.
    out$=LEFT$(PEEK$(_dirC&+4),2)
    p&=_dirC&
Found::
Rem    PRINT "Current:",out$,"Left to process:",MID$(in$,off%,len%)
Rem    PRINT "Current device:",PEEK$(p&+4)
    IF MID$(in$,off%,1)="\"    Rem absolute pathname
        out$=out$+"\"
        len%=len%-1
        off%=off%+1
    ELSE    Rem Relative path, so take it directly
        out$=PEEK$(p&+4)
    ENDIF
    DO
        IF len%=0
            GOTO PrcSeq::
        ENDIF
        c$=MID$(in$,off%,1)
        IF ASC(c$)=%\
PrcSeq::
            IF store$=".."
                i%=LEN(out$)
                WHILE i%>3        Rem after the first \
                    i%=i%-1
                    IF ASC(MID$(out$,i%,1))=%\
                        BREAK
                    ENDIF
                ENDWH
                out$=LEFT$(out$,i%)
            ELSEIF store$<>"." AND LEN(store$)
                out$=out$+store$+"\"
            ENDIF
            store$=""
        ELSE
            store$=store$+c$
        ENDIF
        off%=off%+1: len%=len%-1
    UNTIL len%<0
Rem strip off trailing \
    IF ASC(RIGHT$(out$,1))=%\ AND LEN(out$)>3        Rem AND ASC(RIGHT$(in$,1))<>%\
        out$=LEFT$(out$,LEN(out$)-1)
    ENDIF
Rem    PRINT "Current:",out$        Rem ,"Left to process:",MID$(in$,off%,len%)
    out$=parse$("",out$,#addr&)
    POKEL addr&+12,p&        Rem store address of device in _bdev&
    POKE$ retstr&,out$
    RETURN
ErrTrap::
    ONERR off
    RETURN ERR
ENDP

PROC _getin$:(pr$)
REM Get the user's next line of input
LOCAL i$(248),ret%,i%
    _cpos&=_hpos&
    DO
        ret%=_edit%:(ADDR(i$),248,pr$)
        IF _cpos&=_hpos& AND ret%<>3    Rem 3=enter
            Rem if we are editing 'our' line store it
            IF PEEKL(_cpos&+8)
                FREEALLOC(PEEKL(_cpos&+8))
Rem                FREEALLOC&:(PEEKL(_cpos&+8))
            ENDIF
            POKEL _cpos&+8,ALLOC((LEN(i$)+16) AND $FFF0)
Rem            POKEL _cpos&+8,ALLOC&:((LEN(i$)+16) AND $FFF0,"getin1")
            IF PEEKL(_cpos&+8)=0
                RAISE -10
            ENDIF
            POKE$ PEEKL(_cpos&+8),i$
        ENDIF
        IF ret%=10                    Rem Pagedown
            IF _logid%
                _log:(6,"")
            ELSE
                _cpos&=_hpos&
                GOTO Here
            ENDIF
        ELSEIF ret%=9            Rem Pageup
            IF _logid%
                _log:(5,"")
            ELSE
                _cpos&=PEEKL(_hpos&)
                GOTO Here
            ENDIF
        ELSEIF ret%=5    Rem up
            IF PEEKL(_cpos&+4)=_hpos&
                PRINT CHR$(7);
            ELSE
Rem                PRINT
                _cpos&=PEEKL(_cpos&+4)        Rem previous
                GOTO Here
            ENDIF
        ELSEIF ret%=6                Rem down
            IF _cpos&=_hpos&
                PRINT CHR$(7);
            ELSE
Rem                PRINT
                _cpos&=PEEKL(_cpos&)    Rem next
Here::        i$=PEEK$(PEEKL(_cpos&+8))
            ENDIF
        ENDIF
    UNTIL ret%=3    Rem Enter
    PRINT
    RETURN i$
ENDP

PROC _edit%:(addr&,max%,pr$)
LOCAL i$(255),c%,wx%,off%,k$(255),oldc%,event&(16),ev&
LOCAL y%,xmin%,width%,a%(6),i%,l%
    LOCK OFF                        Rem allow events
    SETCOMPUTEMODE:(KComputeModeOff&)        Rem raise priority
    i$=PEEK$(addr&)
reset::
    off%=LEN(i$)
    wx%=0
start::
    PRINT
    a%(1)=ScrInfo%(1):a%(2)=ScrInfo%(2)
    a%(3)=a%(1)+ScrInfo%(3):a%(4)=a%(2)+ScrInfo%(4)
    IOW(-2,8,a%(),a%())
Rem    AT 30,10: PRINT a%(6)+1,a%(5)+1,wx%,off%,width%
    AT 1,a%(6): PRINT pr$;
Repeat::
    IOW(-2,8,a%(),a%())
    xmin%=a%(5)+1
    width%=ScrInfo%(3)-xmin%+1
    IF width%=0    Rem don't allow a width of 0 or 1
        PRINT " ";
        GOTO Repeat::
    ELSEIF width%>255
        width%=255
    ENDIF
    y%=a%(6)+1
    AT xmin%,y%
    IF LEN(i$)>=width%
        IF off%<>LEN(i$)
            GOTO Print::
        ELSE
            wx%=off%-width%+1
            PRINT RIGHT$(i$,LEN(i$)-wx%);" "
        ENDIF
    ELSE
        PRINT i$;REPT$(" ",width%-LEN(i$))
    ENDIF
    WHILE 1
        AT xmin%+off%-wx%,y%
        CURSOR ON
        oldc%=c%

Rem        PRINT "Waiting for an event...";
        GetEvent32 event&()
Rem        PRINT "Got one."
        ev&=event&(KEvaType%)

        IF NOT ev& AND KEvNotKeyMask&
            c%=ev&
            IF ev&>255                        Rem not a "normal" char
                c%=c%-$0E80            Rem cursor or menu keys
            ELSEIF event&(KEvAKMod%) AND KKmodFn%
Rem many keys CAN'T take these modifiers!!, (eg. cursor keys, Y,U,I,
Rem numeric key, etc. Allow only on a-z (upper and lower case).
                IF (c%>=%A AND c%<=%Z) OR (c%>=%a AND c%<=%z)
                    c%=$0100+c%
                ENDIF
Rem precedence is Fn, Shift
            ELSEIF event&(KEvAKMod%) AND KKmodShift%
                IF c%<=32                    Rem control and special keys + SHIFT
                    c%=$0100+c%        Rem use the same "space" as Fn...
                ENDIF
            ENDIF
        ELSEIF ev&=KEvCommand&
            IF ASC(getcmd$)=%X
                _exit:                    Rem never, ever returns
            ENDIF
        ELSEIF ev&=KEvPtr&
            IF TBarOffer%:(event&(KEvAPtrOplWindowId%),event&(KEvAPtrType%),event&(KEvAPtrPositionX%),event&(KEvAPtrPositionY%)) rem Handles tbar events
            Rem was used, check for an external event
                IF _extevent%            Rem a button has been pressed
                    IF _extevent%=1        Rem generic event, eg. log window..
                        _extevent%=0
                        GOTO start::
                    ENDIF
                    k$=GetVar$:("button"+CHR$(_extevent%))
                    _extevent%=0
                    GOTO UserCommon::        Rem this checks if k$ contains anything
                ENDIF
            ENDIF
            CONTINUE
        ELSE                Rem pointer events & key-up, key-down things, etc
Rem            PRINT "Not a keyboard event!"
            CONTINUE
        ENDIF
Rem        AT 40,4: PRINT "Raw:";c%;"   "
        IF c%>511 OR c%<0        Rem catch overflow conditions
            c%=0
        ELSE
            c%=PEEKB (_keys&+c%)
        ENDIF
Rem        AT 40,5: PRINT c%;"   "
        CURSOR OFF
        VECTOR c%            Rem position 14 & 15, marked Char, is unused
            Del,SDel,Leave,Esc,Leave,Leave,Right,Left,Leave,Leave
            PLeft,PRight,Expand,Char,Char
Rem 16-31 are "user-defined"
            User,User,User,User,User,User,User,User
            User,User,User,User,User,User,User,User
        ENDV
        GOTO Char::
Del::    Rem delete key
        IF off%
            i$=LEFT$(i$,off%-1)+MID$(i$,off%+1,LEN(i$)-off%)
            off%=off%-1
            IF wx% AND (off%-11 < wx%)
                wx%=wx%-1
            ENDIF
            GOTO Print::
        ENDIF
        CONTINUE
SDel::    Rem shift delete
        IF off%<LEN(i$)
            i$=LEFT$(i$,off%)+MID$(i$,off%+2,LEN(i$)-off%-1)
            GOTO Print::
        ENDIF
        CONTINUE
Leave::    Rem anything that returns (Enter, PSION-arrows,etc)
        BREAK
Esc::
        AT xmin%,y% : PRINT REPT$(" ",width%)
        wx%=0
        off%=0
        i$=""
        CONTINUE
Right::
        IF off% < LEN(i$)
            off%=off%+1
            IF off%-wx% >= width%
                wx%=wx%+1
                GOTO Print::
            ENDIF
        ENDIF
        CONTINUE
Left::
        IF off%
            off%=off%-1
            IF wx% AND (off%-11 < wx%)
                wx%=wx%-1
                GOTO Print::
            ENDIF
        ENDIF
        CONTINUE
PLeft::
        off%=0
        wx%=0
        GOTO Print::
PRight::
        off%=LEN(i$)
        IF off%>=width%
            wx%=off%-width%+1
            GOTO Print::
        ENDIF
        CONTINUE
Rem TogLog::
Rem        _log:((_logid%=0)+2,"")
Rem If logid% is 0, this will be -1 + 2 = 1 = create message window
Rem If logid% is <> 0, this will be 0 + 2 = 2 = remove message window!!
Rem        GOTO start::
Expand::            Rem YES! filename expansion!!
        i%=off%
        WHILE i%>0
            IF LOC(" ,",MID$(i$,i%,1))    Rem check for , and " "
                BREAK
            ENDIF
            i%=i%-1
        ENDWH
        k$=_expand$:(MID$(i$,i%+1,off%-i%),-(c%=oldc%))
Rem Spot -(c%=oldc%)!!! - set  for not a single expansion, but a sequence
        IF LEN(k$)<>off%-i%
            c%=0    Rem if length has changed stop expansion
        ENDIF
        l%=LEN(MID$(i$,i%+1,off%-i%))
        IF LEN(k$)+LEN(i$)-l%<=max%
            i$=LEFT$(i$,i%)+k$+RIGHT$(i$,LEN(i$)-off%)
            off%=off%+LEN(k$)-l%
            IF off%-wx%>width%-1
                wx%=off%-width%+1
            ENDIF
            GOTO start::
        ELSE
            PRINT CHR$(7);
            GOTO start::
        ENDIF
User::
        k$=GetVar$:("macro"+num$(c%-15,2))
UserCommon::
        IF LEN(k$)    Rem keyc% exists
            IF ASC(k$)<>%@    Rem macro, not execute
                IF LEN(k$)+LEN(i$)<=max%
                    i$=LEFT$(i$,off%)+k$+RIGHT$(i$,LEN(i$)-off%)
                    off%=off%+LEN(k$)
                    IF off%-wx%>width%-1
                        wx%=off%-width%+1
                    ENDIF
                    GOTO Print::
                ELSE
                    PRINT CHR$(7)
                    CONTINUE
                ENDIF
            ELSE    Rem execute the macro
Rem                AT 1,y% : PRINT REPT$(" ",ScrInfo%(3));
Rem                AT 1,y%
                Rem skip 1st char which will be @
                _proc%:(RIGHT$(k$,LEN(k$)-1))
                IF PEEKB(_curr&+PR_FLAG%)        Rem check for exit...
                    _exit:
                ENDIF
Rem                GOTO reset::
                GOTO start::
            ENDIF
        ELSE
            CONTINUE    Rem keyc% is empty, ignore
        ENDIF
Char::
        IF c%    Rem if it's 0 do nothing
            IF LEN(i$)<max%
                i$=LEFT$(i$,off%)+CHR$(c%)+RIGHT$(i$,LEN(i$)-off%)
                off%=off%+1
                IF off%-wx%>width%-1
                    wx%=wx%+1
                ENDIF
            ELSE
                PRINT CHR$(7)
            ENDIF
Print::    AT xmin%,y%
            IF (LEN(i$) - wx%) >= width%
                PRINT MID$(i$,wx%+1,width%)
            ELSE
                PRINT MID$(i$,wx%+1,LEN(i$)-wx%);" "
            ENDIF
        ENDIF
    ENDWH
    POKE$ addr&,i$
    AT xmin%,y%
    SETCOMPUTEMODE:(KComputeModeOn&)        Rem lower priority
    LOCK ON        Rem stop events
    RETURN c%
ENDP

PROC _proc%:(in$)
Rem Processing loop for command line
LOCAL line$(255),ret%,ticks&,pa&,i%,elapsed&
    ONERR ErrTrap::
    IF _stat%<>-46
        _key%(1)=0
        KEYA(_stat%,_key%())
    ENDIF
    pa&=ALLOC(SEG_SIZE%)    Rem new argument block
Rem    pa&=ALLOC&:(SEG_SIZE%,"proc1")    Rem new argument block
    IF pa&=0
        RAISE -10    Rem no memory
    ENDIF
    POKEL pa&+PR_BACK%,_curr&        Rem store old arg block
    POKEL pa&+PR_OUT%,0                Rem initialize output&input handles
Rem initialize no. args,level,flag and set ARGN to 128
    POKEL pa&,&80000000
    _pid%=UADD(_pid%,1)
    POKEW pa&+PR_NUM%,_pid%        Rem set argument block id
    _curr&=pa&                                    Rem make this current
    line$=in$
Rem    _esc%=0                                            Rem init escape flag
Repeat::
    line$=_afind$:(line$)                        Rem find aliases in command line
    POKEW pa&+PR_INPST%,0                        Rem reset input line status & pos
    _inpar%:(line$,pa&,_spec$)            Rem sets pa&, not ARGV
    WHILE PEEKB(pa&)
        IF LOWER$(PEEK$(PEEKW(pa&+PR_ARGV%)))="if"
            _if%:(pa&)
        ELSEIF LOWER$(PEEK$(PEEKL(pa&+PR_ARGV%)))="time"
            IF ticks&
                PRINT "Nested times not allowed"
            ELSE
                ticks&=DTNow&:
            ENDIF
            FREEALLOC PEEKL(pa&+PR_ARGV%)    Rem free "time" arg
Rem            FREEALLOC&:(PEEKL(pa&+PR_ARGV%))    Rem free "time" arg
            pa&=ADJUSTALLOC(pa&,PR_ARGV%,-4)        Rem remove time!
            IF pa&=0        Rem apparently this should never happen. If it did there'd
                STOP            Rem be no easy way to clean-up. Is the old pa& still
            ENDIF                Rem valid, etc.
            POKEB pa&,PEEKB(pa&)-1
        ELSE
            BREAK
        ENDIF
    ENDWH
    ret%=_subpr%:(pa&)
    POKEW PEEKL(_curr&+PR_BACK%)+PR_STATUS%,ret%    Rem store the status
    _clrA:(pa&)    Rem Deallocate memory for argument list
    IF PEEKB(pa&+PR_FLAG%)    Rem exit flag, set parent's
        POKEB PEEKL(_curr&+PR_BACK%)+PR_FLAG%,1
        GOTO Cleanup::
    ENDIF
    IOYIELD
    IF _stat%<>-46
        IF _key%(1)=27
            GIPRINT ERR$(-114)
            GOTO Cleanup::
        ELSE
            KEYA(_stat%,_key%())
        ENDIF
    ENDIF

    IF PEEKB(pa&+PR_INPST%)
        line$=RIGHT$(line$,LEN(line$)-PEEKB(pa&+PR_INPPS%))
        IF PEEKB(pa&+PR_INPST%)=2    Rem Bloody heck it's a pipe!
            Rem it's a pipe, so OPEN _syspath$\pipe as stdin
            Rem There CAN be no way SHin% is already set...
            Rem    (< redirection comes AFTER this - next command!)
            ret%=IOOPEN(#pa&+PR_IN%,_syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe."+CHR$(PEEKB(pa&+PR_LEV%)),$0120)
            IF ret%    Rem check for original AND creation
                RAISE ret%
            ENDIF
        ENDIF
        GOTO Repeat::
    ENDIF
    GOTO Cleanup::
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    _clrA:(pa&)
Cleanup::
    IF ticks&
        elapsed&=DTNow&:
        PRINT "Elapsed time:",fix$(DTMicrosDiff&:(ticks&,DTNow&:)/1000000.0,3,12),"secs"
        DTDeleteDateTime:(ticks&)
        ticks&=0
    ENDIF
    IF PEEKB(pa&+PR_LEV%)    Rem some pipes - delete
        TRAP DELETE _syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe.?"
        _here$=""    Rem how does this fit with no argv?
    ENDIF
    _curr&=PEEKL(pa&+PR_BACK%)
Rem here's where we'd restore ARGV
    FREEALLOC(pa&)
Rem    FREEALLOC&:(pa&)
    RETURN
ENDP

PROC _if%:(pa&)
Rem Parse 'if' args, shift argv& as necessary
Rem NEW: allow arguments without "==", ie. if $fred echo "fred exists!"
LOCAL i%,neg%,txt$(255),condOK%,j%,p&,args%
    args%=PEEKB(pa&)
    IF args%<3                Rem Must be at least 3 args
Error::
        RAISE -77
    ENDIF
    txt$=PEEK$(PEEKL(pa&+PR_ARGV%+4))    Rem 1st argument, argv&(2)
    i%=8                                            Rem offset of next argument
    IF LOWER$(txt$)="not"
        IF args%<4            Rem with "not" we need at least 4 arguments
            GOTO Error::
        ENDIF
        neg%=-1
        txt$=PEEK$(PEEKL(pa&+PR_ARGV%+8))
        i%=12                                    Rem offset of next argument
    ENDIF
    IF LOWER$(txt$)="exist"
        IF args% < 4 - neg%            Rem 5 args for "not", 4 otherwise
            GOTO Error::
        ENDIF
        IF Fparse%:(ADDR(txt$),PEEK$(PEEKL(pa&+PR_ARGV%+i%)))>=0
            condOK%=1
        ENDIF
        i%=i%+4
    ELSEIF PEEK$(PEEKL(pa&+PR_ARGV%+i%))="=="
        IF args%<5-neg%
            GOTO Error
        ENDIF
Rem        PRINT "Comparing",txt$,"with",PEEK$(PEEKL(pa&+PR_ARGV%+i%+4))
        IF txt$=PEEK$(PEEKL(pa&+PR_ARGV%+i%+4))
            condOK%=1
        ENDIF
        i%=i%+8                    Rem skip == and following argument
    ELSE                                Rem no ==, so just evaluate txt$
        IF LEN(txt$) AND txt$<>"0"
            condOK%=1        Rem set if non-zero argument exists
        ENDIF
    ENDIF
Rem    PRINT "CondOK:";Condok%,
Rem    PRINT "neg:";neg%,
Rem    PRINT "i:";i%
    Rem always free the arguments
    IF (CondOK% + neg%)
        WHILE j%<i%
Rem            PRINT "Freeing",PEEK$(PEEKL(pa&+PR_ARGV%+j%))
            FREEALLOC(PEEKL(pa&+PR_ARGV%+j%))
Rem            FREEALLOC&:(PEEKL(pa&+PR_ARGV%+j%))
            j%=j%+4
        ENDWH
        p&=ADJUSTALLOC(pa&,PR_ARGV%,-i%)
        IF p&=0 OR p&<>pa&    Rem apparently this should never happen. If it did
            STOP                            Rem  there'd be no easy way to clean-up. Is the
        ENDIF                                Rem  old pa& stillvalid, etc.
        POKEB pa&,args%-i%/4
    ELSE
        _clrA:(pa&)    Rem clear args!
    ENDIF
ENDP

PROC _afind$:(src$)
LOCAL len%,c$(255),n%,p&,c%,l%
    len%=LEN(src$)
    WHILE n%<len%
        n%=n%+1
        c%=ASC(MID$(src$,n%,1))
        IF c%<>32
            IF c%=%%
                RETURN RIGHT$(src$,len%-n%)    Rem rest of line
            ELSE    Rem Not a space, so start the 1st word
                c$=RIGHT$(src$,LEN(src$)-n%+1)
                p&=_atab&
                WHILE PEEKL(p&)
                    p&=PEEKL(p&)
                    Rem get length of what we're searching for
                    l%=PEEKB(PEEKL(p&+4))
                    IF LEFT$(c$,l%)=PEEK$(PEEKL(p&+4))
                        Rem check character after the "match"
                        IF LOC(_spec$,MID$(c$,l%+1,1))
                            RETURN PEEK$(PEEKL(p&+8))+RIGHT$(src$,len%-l%-n%+1)
                        ENDIF
                    ENDIF
                ENDWH
                RETURN src$    Rem nothing found
            ENDIF
        ENDIF
    ENDWH
    RETURN    Rem nothing but blanks!
ENDP

PROC SetVar%:(var$,x$)
Rem set the variable var$ to x$
Rem reusing a member of the structure if possible
LOCAL p&,q&,r&,h%,i%,f&,s%,val$(255)
    ONERR  ErrTrap::
    IF ASC(var$)=%_
        RAISE 9                Rem can't write read-only variables
    ENDIF
    val$=x$
    IF var$="history"
        h%=EVAL(val$)
        IF h%<0
            RAISE -7
        ELSE
            _hsz%=h%
            IF _hsz%<_hrsz%    Rem must remove some members
                i%=1
                p&=PEEKL(_hpos&+4)
                q&=_hpos&
                WHILE (p&<>_hpos&)
                    r&=PEEKL(p&+4)                Rem previous
                    IF i%>_hsz%
                        FREEALLOC(PEEKL(p&+8))
Rem                        FREEALLOC&:(PEEKL(p&+8))
                        FREEALLOC(p&)
Rem                        FREEALLOC&:(p&)
                        _hrsz%=_hrsz%-1
                    ELSE
                        q&=p&
                    ENDIF
                    p&=r&                                                    Rem previous
                    i%=i%+1
                ENDWH
                POKEL q&+4,_hpos&
                POKEL _hpos&,q&
                _cpos&=_hpos&            Rem possibly reset history editting pos.
            ENDIF
        ENDIF
    ELSEIF var$="toolbar"
        IF val$="toggle"
            i%=(TbVis%=0)
        ELSEIF val$="on"
            i%=-1
        ELSEIF val$="off"
            i%=0
        ELSE
            RAISE -80
        ENDIF
        IF i%<>TbVis%
            IF i%
                val$="on"
                TBarShow:
            ELSE
                val$="off"
                TBarHide:
            ENDIF
            _setw%:    Rem set display window
        ENDIF
    ELSEIF var$="path"
Rem clear hash table
        p&=PEEKL(_hash&)
        WHILE p&
            q&=p&
            p&=PEEKL(p&)
            FREEALLOC(q&)
        ENDWH
        POKEL _hash&,0
    ELSEIF var$="font"
        i%=LOC(val$,",")
        IF i%
            f&=EVAL(LEFT$(val$,i%-1))
            s%=EVAL(RIGHT$(val$,LEN(val$)-i%))
        ELSE
            f&=EVAL(val$)
            s%=-1
        ENDIF
        IF f&=-1
            f&=ScrInfo%(9)+&10000*ScrInfo%(10)    Rem old font
        ENDIF
        IF s%=-1
            s%=_style%
        ENDIF
        FONT f&,s%
Rem assignments are here so if 'FONT' produces an error the old
Rem values are preserved.
        _style%=s%
        val$=GEN$(f&,10)+","+GEN$(s%,6)
        _setw%:    Rem this is needed as FONT doesn't take the log
                        Rem window into account. ie. the end of screen is
                        Rem not stopped at the log window!!
    ENDIF
    p&=_vars&
    WHILE PEEKL(p&)
        q&=p&
        p&=PEEKL(p&)
        IF PEEK$(PEEKL(p&+4))=var$
            FREEALLOC(PEEKL(p&+8))
Rem            FREEALLOC&:(PEEKL(p&+8))
            Goto Store::
        ENDIF
    ENDWH
    q&=p&
    POKEL p&,ALLOC(16)        Rem 12 rounded to 16 to avoid fragmentation
    Rem POKEL p&,ALLOC&:(16,"setvar1")        Rem 12 rounded to 16 to avoid fragmentation
    p&=PEEKL(p&)
    IF p&=0
        RAISE -10
    ENDIF
    POKEL p&,0
    POKEL p&+4,ALLOC((LEN(var$)+16) AND $FFF0)
Rem    POKEL p&+4,ALLOC&:((LEN(var$)+16) AND $FFF0,"setvar2")
    IF PEEKL(p&+4)=0
        Goto Common::
    ENDIF
Store::
    POKEL p&+8,ALLOC((LEN(val$)+16) AND $FFF0)
Rem    POKEL p&+8,ALLOC&:((LEN(val$)+16) AND $FFF0,"setvar3")
    IF PEEKL(p&+8)=0
        FREEALLOC(p&+4)
Rem        FREEALLOC&:(p&+4)
Common::
        POKEL q&,PEEKL(p&)    Rem clear reference
        FREEALLOC(p&)
Rem        FREEALLOC&:(p&)
        RAISE -10
    ENDIF
    POKE$ PEEKL(p&+4),var$
    POKE$ PEEKL(p&+8),val$
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
ENDP

PROC GetVar$:(var$)
Rem Return variable given in var$
LOCAL p&
    p&=PEEKL(_vars&)
    WHILE p&
        IF PEEK$(PEEKL(p&+4))=var$
            RETURN PEEK$(PEEKL(p&+8))
        ENDIF
        p&=PEEKL(p&)
    ENDWH
ENDP

PROC FreeVar%:(var$)
Rem Free variable given in var$
LOCAL p&,q&
    q&=_vars&
    p&=PEEKL(q&)
    WHILE p&
        IF PEEK$(PEEKL(p&+4))=var$
            IF ASC(var$)=%_
                RAISE 9                    Rem can't write read-only variables
            ENDIF
            FREEALLOC(PEEKL(p&+4))
Rem            FREEALLOC&:(PEEKL(p&+4))
            FREEALLOC(PEEKL(p&+8))
Rem            FREEALLOC&:(PEEKL(p&+8))
            POKEL q&,PEEKL(p&)
            FREEALLOC(p&)
Rem            FREEALLOC&:(p&)
            BREAK
        ENDIF
        q&=p&
        p&=PEEKL(p&)
    ENDWH
    IF p&=0
        PRINT var$, "- Variable not set"
    ENDIF
ENDP

PROC _mkpr$:(p$)
LOCAL i%,flag%,q$(255),c$(255),l%,x$(1),attr%(8)
    ONERR ErrTrap::            Rem otherwise an error ends the program!
    x$=RIGHT$(_spec$,1)    Rem last position of SHspec$
    l%=LEN(p$)
    WHILE i%<l%
        i%=i%+1
        c$=MID$(p$,i%,1)
        IF flag%
            IF c$="H"
                c$=NUM$(_hnum%,6)
            ELSEIF c$="P"
                c$=PrPath$:(_cwd$)
            ELSEIF c$="p"
                parse$(LEFT$(_cwd$,LEN(_cwd$)-1),"",attr%())
                IF LEN(_cwd$)<attr%(4)
                    attr%(4)=attr%(4)-1
                ENDIF
                c$=PrPath$:(MID$(_cwd$,attr%(4),LEN(_cwd$)-attr%(4)+1))
            ELSEIF c$<>x$
                CONTINUE
            ENDIF
            flag%=0
        ELSEIF c$=x$
            flag%=1
            CONTINUE
        ENDIF
        q$=q$+c$
    ENDWH
    RETURN q$
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
ENDP

PROC Fparse%:(addr&,p$)
Rem top level single return wrapper around parse$: and stat%:
Rem that also append '\' (or another sepator) to directories
Rem returns:
Rem -33 : File doesn't exist
Rem -41 : Bad devices
Rem -127 : Wildcards
Rem Else file info
Rem note that on an "error" addr&'s contents may be undefined
LOCAL attr%(8),ret%
    ONERR ErrTrap::
    ret%=parse%:(p$,addr&,ADDR(attr%()))
    IF ret%
        RETURN ret%
    ENDIF
    ret%=stat%:(addr&)
Rem stat% now also does this
Rem    IF (ret%>=0) AND ((ret% AND 16)=16)    Rem AND ASC(RIGHT$(buf$,1))<>%\
Rem        buf$=buf$+"\"                        Rem must be a directory
Rem    ENDIF
    IF attr%(6)    Rem wilcards
        RETURN -127
    ELSE
        RETURN ret%
    ENDIF
ErrTrap::
    RETURN ERR
ENDP

PROC stat%:(addr&)
Rem Takes a pathname and the data returned by parse$:() and
Rem finds the status of the file. Returns ERR or file flags
REM - Directories/files MUST NOT BE terminated by \
REM - Only FULL pathnames work
REM - Returns the wrong value for a directory open on Z: - now returns -69
REM - So should only be called on directories known to exist, e.g. via DIR$
REM Should only be run after parse% as we don't check if the device exists
LOCAL ret%,h%,out%,buf$(255)
    ONERR ErrTrap::
    IF PEEKB(addr&)<4        Rem length of input string
        RETURN 16        Rem ONLY x:\
    ENDIF
    buf$=DIR$(PEEK$(addr&))
    IF LEN(buf$)                    Rem exists
        ret%=IOOPEN(h%,buf$,$0400)        Rem this is faster than another DIR$
Rem 0=file, -9 file in use, anything else counted as a directory!!
        IF ret%=0
            IOCLOSE(h%)
        ELSEIF ret%<>-9                                Rem for z: this could be -33!!!
            buf$=buf$+"\"
            out%=16
        ENDIF
        POKE$ addr&,buf$
    ELSE
        out%=-33
    ENDIF
    RETURN out%
ErrTrap::
    RETURN ERR
ENDP

PROC xstat%:(p$)
Rem Version of stat% that doesn't use DIR$, so is safe within other DIR$
Rem returns a bad value (-33) for a directory on ROM
LOCAL ret%,h%,out%
    ONERR ErrTrap::
    IF LEN(p$)<4
        RETURN 16        Rem ONLY x:\
    ENDIF
    ret%=IOOPEN(h%,p$,$0400)
Rem    PRINT "HANDLE:",h%,"RETURN",ret%
    IF ret%=0 OR ret%=-9
        IF ret%=0
            IOCLOSE(h%)
        ENDIF
    ELSEIF ret%<>-33                            Rem not a file
        out%=16
    ELSE
        out%=-33
    ENDIF
Rem check attributes here? Check what I say this routine does
    RETURN out%
ErrTrap::
    RETURN ERR
ENDP

PROC _run%:(p$)
Rem .bat program executor, read the whole batch file into memory,
Rem    after all they aren't exactly going to be very long....
LOCAL ret%,handle%,p&,labels&,WaitLbl%,params%,exit%
LOCAL line$(255),baseadr&,q&,i%,txt$(255),label$(8)
LOCAL offset&,pa&,xpa&
    ONERR ErrTrap::
    IF _stat%<>-46
        _key%(1)=0
        KEYA(_stat%,_key%())
    ENDIF
    pa&=ALLOC(SEG_SIZE%)
Rem    pa&=ALLOC&:(SEG_SIZE%,"run1")
    baseadr&=ALLOC(4)    Rem list for storing batch commands
Rem    baseadr&=ALLOC&:(4,"run2")    Rem list for storing batch commands
    labels&=ALLOC(8)        Rem start of list of labels
Rem    labels&=ALLOC&:(8,"run3")        Rem start of list of labels
    IF labels&=0 OR baseadr&=0 OR pa&=0
        RAISE -10
    ENDIF
    POKEL pa&+PR_BACK%,_curr&        Rem store old arg block
    POKEL pa&+PR_OUT%,0    Rem initialize output&input handles
Rem initialize no. args,level,flag and set ARGN to 128
    POKEL pa&,&80000000
    _pid%=UADD(_pid%,1)            Rem keep this as UADD to allow wraps
    POKEW pa&+PR_NUM%,_pid%        Rem set argument block id
    _curr&=pa&                                    Rem make this current
    POKEL baseadr&,0
    POKEL labels&,0
    ret%=IOOPEN(handle%,p$,$0420)
    IF ret%<0
        RAISE ret%
    ENDIF
    p&=baseadr&    Rem start of linked list for storing commands
    DO
        ret%=IOREAD(handle%,ADDR(line$)+1,255)
        IF ret%<0
            IF  ret%<>-36    Rem EOF
                RAISE ret%
            ENDIF
        ELSE    Rem not EOF
            POKEB ADDR(line$),ret%
            POKEL p&,ALLOC((LEN(line$)+20) AND $FFF0)
Rem            POKEL p&,ALLOC&:((LEN(line$)+20) AND $FFF0,"run4")
            Rem space for pointer + 1 + 15
            p&=PEEKL(p&)    Rem  next element
            IF p&=0
                RAISE -10
            ENDIF
            POKEL p&,0    Rem mark end
            POKE$ p&+4,line$
        ENDIF
    UNTIL ret%=-36

    Rem commands file in baseadr% list
Rem    _esc%=0            Rem clear Esc flag
    p&=PEEKL(baseadr&)
    WHILE p&
        line$=PEEK$(p&+4)
        IF _opts%(varEcho%)                Rem if varEcho is on, print lines of batch file
            PRINT line$
        ENDIF
        IF LEN(_here$)    Rem <<
            IF line$<>_here$
                IF xpa&=0    Rem no argument block
                    xpa&=ALLOC(SEG_SIZE%)
Rem                    xpa&=ALLOC&:(SEG_SIZE%,"run6")
                    IF xpa&=0
                        RAISE -10
                    ENDIF
                    POKEB xpa&+PR_ARGN%,128    Rem initialize max args
                    POKEB xpa&+PR_LEV%,0
                    POKEW xpa&+PR_STATUS%,0
                    POKEL xpa&+PR_BACK%,pa&    Rem store old arg block
                ENDIF
                POKEB xpa&,0                Rem initialize no. args
Rem                Rem don't look for >,<,; or Ý
                _inpar%:(line$,xpa&," ""'*?{}  =+-/#  !"+RIGHT$(_spec$,2))
                i%=0
                line$=""
                WHILE i%<PEEKB(xpa&)    Rem while there are arguments
                    q&=PEEKL(xpa&+PR_ARGV%+4*i%)
                    txt$=PEEK$(q&)
                            FREEALLOC q&
Rem                    FREEALLOC&:(q&)
                    Rem mustcontinue to free, even if line$ is too long
                    IF LEN(line$) AND LEN(line$)<255    Rem not the first entry
                        line$=line$+" "
                    ENDIF
                    IF LEN(line$)+LEN(txt$)<=255
                        line$=line$+txt$
                    ELSE
                        line$=line$+LEFT$(txt$,255-LEN(line$))
                    ENDIF
                    i%=i%+1
                ENDWH
                IOWRITE(PEEKW(pa&+PR_IN%),ADDR(line$)+1,LEN(line$))
                IF PEEKL(p&)    Rem not last line in file
                    GOTO skip::
                ELSE
                    GOTO end::
                ENDIF
            ELSE
end::        IOSEEK(PEEKW(pa&+PR_IN%),6,offset&)
                POKEB(pa&+PR_INPST%),0    Rem cancel multicommand lines
                FREEALLOC(xpa&)
Rem                FREEALLOC&:(xpa&)
                xpa&=0
                _here$=""
                GOTO Again::
            ENDIF
        ENDIF
Repeat::
        line$=_afind$:(line$)    Rem find aliases
        POKEW pa&+PR_INPST%,0    Rem reset input line status & pos
        _inpar%:(line$,pa&,_spec$)
        IF LEN(_here$)    Rem "here" redirection
            GOTO skip::
        ENDIF
Again::    Rem check for batch specific stuff
        IF PEEKB(pa&)=0
            GOTO Next::
        ENDIF
        txt$=LOWER$(PEEK$(PEEKL(pa&+PR_ARGV%)))
        IF txt$="if"
            _if%:(pa&)
            GOTO Again::
        ELSEIF ASC(txt$)=%:
            txt$=RIGHT$(PEEK$(PEEKL(pa&+PR_ARGV%)),LEN(txt$)-1)
            GOTO Here::
        ELSEIF  RIGHT$(txt$,2)="::"
Rem use argv%(1) as txt$ is the lower case version of it
            txt$=LEFT$(PEEK$(PEEKL(pa&+PR_ARGV%)),LEN(txt$)-2)
Here::    IF LEN(txt$) > 8
                txt$=LEFT$(txt$,8)
            ENDIF
            Rem store the label
Rem            PRINT "Storing label:",txt$
            q&=labels&
            WHILE PEEKL(q&)
                q&=PEEKL(q&)
                IF PEEK$(q&+8)=txt$
                    PRINT "DEBUG: Duplicate label."
                    q&=0
                    BREAK
                ENDIF
            ENDWH
            IF q&
                Rem space for next pointer and pointer to line
                POKEL q&,ALLOC((LEN(txt$)+24) AND $FFF0)
Rem                POKEL q&,ALLOC&:((LEN(txt$)+24) AND $FFF0,"run5")
                q&=PEEKL(q&)
                IF q&=0
                    RAISE -10
                ENDIF
                POKEL q&,0    Rem terminate list
                POKEL q&+4,p&    Rem address of line
                POKE$ q&+8,txt$    Rem label
            ENDIF
            IF txt$=label$
                WaitLbl%=0
            ENDIF
        ELSEIF WaitLbl%    Rem do nothing, MUST be after :.. & ..:: check
        ELSEIF txt$="goto"
            IF PEEKB(pa&)<>2
                PRINT "Bad GOTO"
                BREAK
            ENDIF
            txt$=PEEK$(PEEKL(pa&+PR_ARGV%+4))
            Rem Search for txt$ in the list of labels
Rem            PRINT "Searching for label",txt$
            q&=PEEKL(labels&)
            WHILE q&
Rem                PRINT "Comparing with",PEEK$(q&+8)
                IF PEEK$(q&+8)=txt$
Rem                    PRINT "Found!!!"
                    Rem found the label
                    p&=PEEKL(q&+4)    Rem stored line
                    Rem normal processing will get p&=PEEKL(p&)
                    BREAK
                ENDIF
                q&=PEEKL(q&)
            ENDWH
            IF q&=0    Rem not found
                label$=txt$
                WaitLbl%=1
            ENDIF
        ELSE
            ret%=_subpr%:(pa&)
            Rem this is the PARENT'S status!
            POKEW PEEKL(_curr&+PR_BACK%)+PR_STATUS%,ret%
            Rem store the status
        ENDIF
Next::
        _clrA:(pa&)
        IF PEEKB(pa&+PR_FLAG%)    Rem have an exit
            exit%=ret%    Rem should have just come from SHsubpr
            BREAK
        ENDIF
        IOYIELD
        IF _stat%<>-46                        Rem here, so it's just after a SHclrA
            IF _key%(1)=27
Rem                GIPRINT ERR$(-114)    Rem this will be done in calling procedure
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF

        IF PEEKB(pa&+PR_INPST%)
            line$=RIGHT$(line$,LEN(line$)-PEEKB(pa&+PR_INPPS%))
            IF PEEKB(pa&+PR_INPST%)=2    Rem Bloody heck it's a pipe!
                Rem There CAN be no way _in% is already set...
                ret%=IOOPEN(#pa&+PR_IN%,_syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe."+CHR$(PEEKB(pa&+PR_LEV%)),$0120)
                IF ret%    Rem check for original AND creation
                    RAISE ret%
                ENDIF
            ENDIF
            GOTO Repeat::
        ENDIF
Skip::
        p&=PEEKL(p&)
    ENDWH
    IF WaitLbl%
        PRINT "No such label:",label$
    ENDIF
    GOTO DelArg
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    exit%=ERR
DelArg::    Rem common clean up - error and normal termination
    IF xpa&    Rem this shouldn't really happen
        PRINT "DEBUG: How did xpa& get set?"
        FREEALLOC(xpa&)
Rem        FREEALLOC&:(xpa&)
Rem        Rem We'll trust there are no arguments to clear!!
    ENDIF
    _clrA:(pa&)
    IF PEEKB(pa&+PR_LEV%)    Rem some pipes - delete
        TRAP DELETE _syspath$+NUM$(PEEKW(pa&+PR_NUM%),5)+"pipe.?"
        _here$=""    Rem how does this fit with no argv?
    ENDIF
    _curr&=PEEKL(pa&+PR_BACK%)
Rem here's where we'd restore ARGV
    FREEALLOC(pa&)
Rem    FREEALLOC&:(pa&)
    IOCLOSE(handle%)
    p&=labels&
    WHILE p&
        q&=PEEKL(p&)
        FREEALLOC(p&)
Rem        FREEALLOC&:(p&)
        p&=q&
    ENDWH
    p&=baseadr&
    WHILE p&
        q&=PEEKL(p&)
        FREEALLOC(p&)
Rem        FREEALLOC&:(p&)
        p&=q&
    ENDWH
    RETURN exit%
ENDP

PROC _expand$:(in$,f%)
Rem f% is set if it's the 2nd or more expansion
LOCAL buf$(255),attr%(8),ret%,file$(255),i%,x$(255),dlen%,dlist&,dcurr&
LOCAL n%,l%,end$(3),sep$(1),p&,q&,h%,s1%,s2%,dbuf$(255)
    ONERR ErrTrap::
    IF _stat%<>-46
        _key%(1)=0
        KEYA(_stat%,_key%())
    ENDIF
    IF parse%:(in$+"*",ADDR(buf$),ADDR(attr%()))
        GOTO exit::
    ENDIF
Rem    PRINT buf$,attr%(1),attr%(2),attr%(3),attr%(4),attr%(5),attr%(6),LEN(buf$),f%
    IF _opts%(varUNIXpath%)
        end$="/\:"
        sep$="/"
    ELSE
        end$="\:"
        sep$="\"
    ENDIF

    l%=LEN(in$)
    WHILE l%
Rem end$ contains the characters that could delimit the pathname
        IF LOC(end$,MID$(in$,l%,1))
            BREAK
        ENDIF
        l%=l%-1
    ENDWH

    Rem if the part we're "replacing" is . or .. and the device can have
    Rem    subdirectories, just return the input + separator
    IF RIGHT$(in$,LEN(in$)-l%)=".." OR RIGHT$(in$,LEN(in$)-l%)="."
        RETURN in$+sep$
    ENDIF
Rem    PRINT buf$
Rem    IF LOC(RIGHT$(buf$,LEN(buf$)-attr%(4)+1),":")
Rem        Rem this covers a whole load of badness - : in filename part
Rem        GOTO exit::
Rem    ENDIF
    dlen%=attr%(4)-1    Rem length of directory part
    x$=DIR$(buf$)
Rem workaround for the bug that if a directory is exactly 8 chars, a DIR of
Rem the directory+* yields nothing. Retry without the wildcard
    IF LEN(x$)=0
        x$=LEFT$(buf$,LEN(buf$)-1)
        x$=DIR$(x$)
    ENDIF
    IF LEN(x$)
        file$=RIGHT$(x$,LEN(x$)-dlen%)
Rem initialize the display list
        dlist&=ALLOC(16)
Rem        dlist&=ALLOC&:(16,"expand1")
        IF dlist&=0
            RAISE -10        Rem no memory
        ENDIF
        POKEL dlist&,0                Rem clear "next" pointer
        dcurr&=dlist&                    Rem current position in display list
        POKEW dlist&+4,0        Rem set max width=0
        WHILE LEN(x$)
            IOYIELD
            IF _stat%<>-46
                IF _key%(1)=27
                    GIPRINT ERR$(-114)
                    GOTO exit::
                ELSE
                    KEYA(_stat%,_key%())
                ENDIF
            ENDIF
            x$=RIGHT$(x$,LEN(x$)-dlen%)
            i%=1
            IF LEN(file$)
                WHILE i%<=LEN(file$)
                    IF UPPER$(MID$(x$,i%,1))<>UPPER$(MID$(file$,i%,1))
                        file$=LEFT$(file$,i%-1)
                        BREAK
                    ENDIF
                    i%=i%+1
                ENDWH
            ELSEIF f%=0        Rem not showing expansions so exit if
                                        Rem file$ has "gone" completely
                BREAK
            ENDIF

            n%=n%+1
            POKEL dcurr&,ALLOC((LEN(x$)+20) AND $FFF0)
Rem            POKEL dcurr&,ALLOC&:((LEN(x$)+20) AND $FFF0,"expand2")
Rem length of file$ + 1 + 15 for 16 byte boundry + long pointer
            IF PEEKL(dcurr&)=0
                RAISE -10
            ENDIF
            IF LEN(x$)>PEEKW(dlist&+4)
                POKEW(dlist&+4),LEN(x$)
            ENDIF
            dcurr&=PEEKL(dcurr&)
            POKEL dcurr&,0                                    Rem clear next
Rem            PRINT "Storing",x$
            POKE$ dcurr&+4,x$
            x$=DIR$("")
        ENDWH
        IF n%>1    Rem more than a single match
            IF f%
                i%=PEEKW(dlist&+4)+2
                n%=i%
                p&=PEEKL(dlist&)
                PRINT
                x$=""                Rem display list
                WHILE p&
                    x$=x$+PEEK$(p&+4)
                    ret%=IOOPEN(h%,LEFT$(buf$,dlen%)+PEEK$(p&+4),$0400)    Rem read-only, shared
                    IF ret%=-9                    Rem file in use
                        x$=x$+"#"
                    ELSEIF ret%=0            Rem -9 is file in use
                        x$=x$+" "
                        IOCLOSE(h%)
                    ELSE
                        x$=x$+sep$
                    ENDIF
                    n%=n%+i%
Rem subtlety here. x$ is only appended with white space if the line ISN'T printed
Rem This has two functions - firstly it's more efficient and secondly it allows us
Rem to print nearer to the right-hand margin
                    IF n%>ScrInfo%(3)
                        PRINT x$
                        x$=""
                        n%=i%
Rem only test for escape key every so often. Else the slowdown IS noticable
                        IOYIELD
                        IF _stat%<>-46
                            IF _key%(1)=27
                                GIPRINT ERR$(-114)
                                GOTO exit::
                            ELSE
                                KEYA(_stat%,_key%())
                            ENDIF
                        ENDIF
                    ELSE
                        x$=x$+REPT$(" ",i%-PEEKB(p&+4)-1)
                    ENDIF
                    p&=PEEKL(p&)
                ENDWH
                IF n%<>i%
                    PRINT x$
                ENDIF
            ELSE
                PRINT CHR$(7);
            ENDIF
        ELSE
Rem            PRINT "Checking if",LEFT$(buf$,dlen%)+file$,"is a directory"
            ret%=xstat%:(LEFT$(buf$,dlen%)+file$)
Rem a bit of a hack!! Because the string has come via a DIR$ it MUST
Rem exist. But IOOPEN on a directory in z: returns -33 so is incorrectly
Rem flagged. Workaround is to check the other way - ie. for the file
Rem It worked before as we checked for a file too
            IF ret%=0
                    file$=file$+" "
            ELSE
                    file$=file$+sep$
            ENDIF
        ENDIF
        x$=PrPath$:(LEFT$(in$,l%)+file$)
        GOTO Common::
    ENDIF
ErrTrap::
    ONERR off
exit::
    PRINT CHR$(7);
    x$=in$
Common::
    IF dlist&        Rem if the display list was ever used, clean it up
        p&=PEEKL(dlist&)
        WHILE p&
            q&=PEEKL(p&)
Rem        PRINT "Freeing:",PEEK$(p&+4)
            FREEALLOC(p&)
Rem            FREEALLOC&:(p&)
            p&=q&
        ENDWH
        FREEALLOC(dlist&)
Rem        FREEALLOC&:(dlist&)
    ENDIF
    RETURN x$
ENDP

PROC err$:(err%)
    VECTOR err%
        l1,l2,l3,l4,l5,l6,l7,l8,l9,l10,l11
    ENDV
    IF err%=-111
        RETURN "Argument overflow"
    ELSEIF err%=-127
        RETURN "Wildcards not allowed"
    ELSEIF err%=-71
        RETURN "Buffer overflow"
    ELSEIF err%=-33
        RETURN "No such file or directory"
    ELSE
        RETURN ERR$(err%)
    ENDIF
l1::
    RETURN "Not a directory"
l2::
    RETURN "Must be a directory"
l3::
    RETURN "Not a plain file"
l4::
    RETURN "No match"
l5::
    RETURN "Input/output redirection invalid for batch files"
l6::
    RETURN "No such variable"
l7::
    RETURN "Missing '"
l8::
    RETURN "Bad ${..}"
l9::
    RETURN "Cannot write system read-only variables"
l10::
    RETURN "Bad redirection"
l11::
    RETURN "Not unique"
ENDP

PROC PrFmt$:(buf$,len%)
    IF LEN(buf$)<len%
        RETURN buf$+REPT$(" ",len%-LEN(buf$))
    ELSE
        RETURN buf$+" "
    ENDIF
ENDP

PROC _setw%:
Rem set the size of the text window
Rem - status and/or log window may be visible
LOCAL w%,width%
    width%=ScrWid%+TbVis%*TbWidth%
    SCREENINFO ScrInfo%()    Rem get current settings
    gUSE 1
    gSETWIN 0,0,width%,ScrHght%-_logh%
    w%=width%/ScrInfo%(7)        Rem screen width/char width
    IF w% < ScrInfo%(3)
        Rem screen has shrunk!
        IF width% > (w%*ScrInfo%(7)+ScrInfo%(1))
            Rem there are pixel columns visible that aren't part of the
            Rem    text screen. If these have pixels set they won't be
            Rem    scrolled off the screen. This will happen when the
            Rem    font is changed and the status window is displayed
            Rem    and this is redundant. It's needed when the status
            Rem    window is displayed without clearing the screen
            gAT w%*ScrInfo%(7)+ScrInfo%(1),0
            gFILL width%-w%*ScrInfo%(7)-ScrInfo%(1),ScrHght%-_logh%,1
Rem            PRINT width%-w%*ScrInfo%(7)
        ENDIF
    ENDIF
    SCREEN w%,(ScrHght%-_logh%-ScrInfo%(2))/ScrInfo%(8),1,1
    IF _logid% AND width%<>_logw%    Rem width changed
        gUSE _logid%
        gSETWIN 0,ScrHght%-_logh%,width%,_logh%
        _logw%=width%
        _log:(1,"")    Rem redraw log window
    ENDIF
    SCREENINFO ScrInfo%()    Rem save any new state
ENDP

PROC _log:(op%,val$)
Rem op%: 1 - create/redisplay log window
Rem op%: 2 - delete log window
Rem op%: 3 - new message
Rem op%: 4 - append message
Rem op%: 5 - scroll back
Rem op%: 6 - scroll forward
Rem op%: 7 - clear log
LOCAL a%(6),i%,width%
LOCAL p&,inf&(48),y%,h%,buf$(255),pos%
    ONERR ErrTrap::
    gUPDATE OFF
    width%=ScrWid%+TbVis%*TbWidth%
    VECTOR op%
        make,destroy,new,appnd,bck,forward,clear
    ENDV
    PRINT "Unknown operation",op%
    GOTO exit::
make::    Rem create
    IF _logid%    Rem already exists, just redraw
        gUSE _logid%
        gAT 0,0: gFILL _logw%,_logh%,1    Rem clear old one
        GOTO Common::
    ELSE
        _logw%=width%
        buf$=GetVar$:("logheight")
        IF LEN(buf$)
            _logh%=VAL(buf$)
        ELSE
            _logh%=48
        ENDIF
        IF _logh%>ScrHght%/2
            _logh%=ScrHght%/2        Rem max out at half the screen height
        ENDIF
        a%(1)=ScrInfo%(1):a%(2)=ScrInfo%(2)
        a%(3)=a%(1)+ScrInfo%(3):a%(4)=a%(2)+ScrInfo%(4)
        IOW(-2,8,a%(),a%())
        i%=(ScrHght%-_logh%-ScrInfo%(2))/ScrInfo%(8)
        Rem i% = number of lines in new text window
        IF a%(6)>=i%
            gUSE 1
            gAT 0,ScrInfo%(2)
            gCOPY 1,0,(a%(6)-i%+1)*ScrInfo%(8)+ScrInfo%(2),width%,i%*ScrInfo%(8),3
            gAT 0,ScrInfo%(2)+i%*ScrInfo%(8)
            gFILL width%,ScrHght%-_logh%-i%*ScrInfo%(8)-ScrInfo%(2),1
            AT 1,i%
        ENDIF
        _setw%:    Rem here so SHlogid% ISN'T used/taken into account
                        Rem but we reset windows according to the new
                        Rem SHlogh%,SHlogw%
        _logid%=gCREATE(0,ScrHght%-_logh%,_logw%,_logh%,1,0)
Common::
        gBORDER 0
        gFONT KFontTimesNormal15&
        gSTYLE 1
Rem        gGREY 1
Rem        gAT 19,18: gPRINT "Shell3a"
Rem        gGREY 0
        gAT 98,0: gLINEBY 0,_logh%
        IF _logh%>17
            gAT 22,16: gPRINT "Shell 5"
            gAT 1,19
            gLINEBY 97,0
            IF _logh%>30
                gFONT KFontArialNormal8&
                gAT 4,30: gPRINT "v"+_VERSION$
                gSTYLE 0
                gAT 63,30: gPRINT "©1998"
                IF _logh%>40
                    gSTYLE 32
                    gAT 39,39: gPRINT "Nick Murray"
                    IF _logh%>43
                        gAT 1,41
                        gLINEBY 97,0
                        gAT 0,42
                        gFILL 98,_logh%-42,1
                    ENDIF
                ENDIF
            ENDIF
        ENDIF
    ENDIF
    y%=_logn%            Rem keep position in log
    GOTO Display::
destroy::
    IF _logid%
        gCLOSE _logid%
        _logw%=0
        _logh%=0
        _logid%=0
        _setw%:
    ENDIF
    GOTO exit::
new::
    IF _logl%
        p&=REALLOC(_logs&,(_logl%*4+17) AND $FFF0)
    ELSE
        p&=ALLOC(16)    Rem round 4 to 16!
    ENDIF
    IF p&
        _logs&=p&
    ELSE
        RAISE -10
    ENDIF
    buf$=RIGHT$(DATIM$,9)+": "+val$
    p&=ALLOC((LEN(buf$)+16) AND $FFF0)
    IF p&
        POKE$ p&,buf$
        POKEL _logs&+_logl%*4,p&
    ELSE
        RAISE -10
    ENDIF
    _logl%=_logl%+1    Rem number of items in log
    y%=_logl%
Display::
    IF _logid%
        gUSE _logid%
        gFONT KFontArialNormal8&
        gSTYLE 0
        gINFO32 inf&()
        Rem height of log window in character units
        h%=(_logh%-2)/(inf&(3)+1)
        IF y%<h%
            y%=h%
        ENDIF
        IF y%>_logl%
            y%=_logl%
        ENDIF
        i%=y%-h%
        IF i%<0
            i%=0
        ENDIF
        pos%=9
        WHILE i%<y%
            gAT 100,pos%
            gPRINTB PEEK$(PEEKL(_logs&+i%*4)),_logw%-102
            pos%=pos%+inf&(3)+1
            i%=i%+1
        ENDWH
    ENDIF
    _logn%=y%    Rem both when displayed and when not
    GOTO exit::
appnd::
    IF _logl%
        buf$=PEEK$(PEEKL(_logs&+_logl%*4-4))
        IF LEN(buf$)+LEN(val$)>255
            GOTO new::    Rem new thing is too long
        ENDIF
        buf$=buf$+val$
        p&=REALLOC(PEEKL(_logs&+_logl%*4-4),(LEN(buf$)+16) AND $FFF0)
        IF p&
            POKEL _logs&+_logl%*4-4,p&
        ELSE
            RAISE -10
        ENDIF
        POKE$ p&,buf$
    ELSE
        GOTO new::    Rem no previous line - start a new one
    ENDIF
    IF _logid%
        y%=_logl%
        GOTO Display::
    ENDIF
    GOTO exit::
bck::
    y%=_logn%-1
    GOTO Display::
forward::
    y%=_logn%+1
    GOTO Display::
clear::
    IF _logl%    Rem anything here?
        IF _logid%    Rem displayed?
            gUSE _logid%
            gAT 100,1
            gFILL _logw%-102,_logh%-2,1
        ENDIF
        WHILE _logl%
Rem            PRINT PEEK$(PEEKW(UADD(SHlogs%,SHlogl%*2-2)))
            FREEALLOC PEEKL(_logs&+_logl%*4-4)
            _logl%=_logl%-1
        ENDWH
        FREEALLOC _logs&
    ENDIF
exit::
    gUPDATE ON
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    gUPDATE ON
ENDP

PROC _nodes:
LOCAL i%,p&,d$(3)
    ONERR ErrTrap::
    p&=_dirB&        Rem Set current end
    POKEL p&,0        Rem denote limit of linked list
    _dirC&=0
    _log:(3,"Scanning for attached drives...")        Rem bold
    DO
        d$=CHR$(%A+i%)+":\"
        ONERR BadDir::
        DIR$(d$)        Rem if this fails we'll jump to BadDir::
        ONERR ErrTrap::    Rem back to normal exception handling
        _log:(4,"  "+LEFT$(d$,2))    Rem append
Rem Store on the heap the data about this dir
Rem format:
Rem 0: Pointer to next entry
Rem 4: Max 256 of path +size
        POKEL p&,ALLOC(260)
Rem        POKEL p&,ALLOC&:(260,"nodes1")
        IF PEEKL(p&)=0                Rem memory NOT allocated
            RAISE -10        Rem no system memory
        ENDIF
        p&=PEEKL(p&)
        POKEL p&,0
        POKE$ p&+4,d$
        IF d$="C:\"    Rem found starting directory
            _dirC&=p&
        ENDIF
next::
        i%=i%+1
    UNTIL i%>25

    IF _dirC&
        _cwd$=PEEK$(_dirC&+4)
    ELSE
        ALERT("No filesystems found!!")
        STOP
    ENDIF
Rem    _log:(3,"...completed.")
    RETURN
BadDir::
    ONERR ErrTrap::
    GOTO next::
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
ENDP

PROC _Err:(i%,n%)
    PRINT PrPath$:(PEEK$(argv&(i%))),"-",err$:(n%)
ENDP

PROC _cd%:(path$)
Rem change current directory. Error handling to be done in calling procedure
LOCAL buf$(255),ret%,attr%(8)
    parse%:(path$,ADDR(buf$),ADDR(attr%()))
    ret%=stat%:(ADDR(buf$))
    IF ret%<0
        RAISE ret%
    ELSEIF ret% AND (ret% AND 16)
        _cwd$=buf$
        _dirC&=PEEKL(ADDR(attr%())+12)
        POKE$ _dirC&+4,buf$
    ELSE
        RAISE 1            Rem not a directory
    ENDIF
    IF _opts%(varcwdcmd%)
        buf$=GetVar$:("cwdcmd")
        IF LEN(buf$)
            _proc%:(buf$)
        ENDIF
    ENDIF
ENDP

PROC alias%:(n%)
REM narg%=1 - print all aliases
REM narg%=2 - print alias for arg2
REM narg%>2 - set alias of arg2 = arg3.....
LOCAL buf$(255),p&,i%,q&
    ONERR ErrTrap::
    IF n%=2
        p&=PEEKL(_atab&)
        WHILE p&
            IF PEEK$(PEEKL(p&+4))=PEEK$(argv&(2))
                fprint%:(PrFmt$:(PEEK$(PEEKL(p&+4)),10)+PEEK$(PEEKL(p&+8)))
                BREAK
            ENDIF
            p&=PEEKW(p&)
        ENDWH
        IF p&=0
            PRINT "Alias not found"
        ENDIF
    ELSEIF n%=1
        p&=PEEKL(_atab&)
        WHILE p&
            fprint%:(PrFmt$:(PEEK$(PEEKL(p&+4)),10)+PEEK$(PEEKL(p&+8)))
            p&=PEEKL(p&)
        ENDWH
    ELSE
        i%=3
        WHILE i%<=n%
            buf$=buf$+PEEK$(argv&(i%))+" "
            i%=i%+1
        ENDWH
        buf$=LEFT$(buf$,LEN(buf$)-1)    Rem remove last " "
Rem add new aliases from the start of the list so they are 1st
        p&=ALLOC(16)                    Rem new element - only needs 12
Rem        p&=ALLOC&:(16,"alias1")                    Rem new element - only needs 12
        IF p&=0
            RAISE -10
        ENDIF
        POKEL p&,PEEKW(_atab&)    Rem address of next element
        POKEL _atab&,p&                        Rem insert new 1st element
        q&=ALLOC((LEN(PEEK$(argv&(2)))+16) AND $FFF0)
Rem        q&=ALLOC&:((LEN(PEEK$(argv&(2)))+16) AND $FFF0,"alias2")
        IF q&=0    Rem 2nd alloc failed, clear 1st
            GOTO Common::
        ENDIF
        POKEL p&+4,q&
        POKE$ q&,PEEK$(argv&(2))
        q&=ALLOC((LEN(buf$)+16) AND $FFF0)
Rem        q&=ALLOC&:((LEN(buf$)+16) AND $FFF0,"alias3")
        IF q&=0    Rem 3rd failed, clear 1&2
            FREEALLOC(p&+4)        Rem clear allocation above
Rem            FREEALLOC&:(p&+4)        Rem clear allocation above
Common::
            POKEL _atab&,PEEKL(p&)    Rem reattach old list
            FREEALLOC(p&)
Rem            FREEALLOC&:(p&)
            RAISE -10
        ENDIF
        POKEL p&+8,q&
        POKE$ q&,buf$
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC at%:(n%)
LOCAL i%,x%,y%,buf$(255)
    ONERR ErrTrap::
    IF n%<>2
Usage::
        PRINT "Usage: at <xpos>,<ypos>"
        RETURN -2
    ELSE
        buf$=PEEK$(argv&(2))
        i%=LOC(buf$,",")
        IF i%
            AT VAL(LEFT$(buf$,i%-1)),VAL(RIGHT$(buf$,LEN(buf$)-i%))
        ELSE
            GOTO Usage::
        ENDIF
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC banner%:(n%)
LOCAL id%,xlim&,y%,i&(48),d%(16),bit%,c%,line$(255),s%,f&,ch%,a&,l%,arg%
LOCAL flag%,count%
    ONERR ErrTrap::
    ch%=%#        Rem default character
    f&=10            Rem default font
    arg%=2
    WHILE arg%<=n%
        line$=PEEK$(argv&(arg%))
        IF line$="-c"
            IF arg%<n%    Rem at least one more argument
                arg%=arg%+1
                ch%=ASC(PEEK$(argv&(arg%)))
            ELSE
                GOTO Usage::
            ENDIF
        ELSEIF line$="-s"
            IF arg%<n%    Rem at least one more argument
                arg%=arg%+1
                s%=EVAL(PEEK$(argv&(arg%)))
            ELSE
                GOTO Usage::
            ENDIF
        ELSEIF line$="-f"
            IF arg%<n%    Rem at least one more argument
                arg%=arg%+1
                f&=EVAL(PEEK$(argv&(arg%)))
            ELSE
                GOTO Usage::
            ENDIF
        ELSE            Rem none of the flags, so go ahead
            BREAK
        ENDIF
        arg%=arg%+1
    ENDWH
    IF arg%>n%    Rem no textual arguments
Usage::
        PRINT "Usage: banner [-c char] [-f font] [-s style] <string>"
        RETURN -2
    ENDIF
    WHILE arg%<n%            Rem concatenate remaining arguments
        arg%=arg%+1
        line$=line$+" "+PEEK$(argv&(arg%))
    ENDWH
    id%=gCREATEBIT(256,32)
    gFILL 256,32,1
    gFONT f&
    gSTYLE s%
    gINFO32 i&()
    Rem i%(4)=font descent
    gAT 0,i&(3)-i&(4):gPRINT line$
    IF _out%        Rem output redirection
        l%=gX                Rem length=length of printed string
    ELSE
        l%=ScrInfo%(3)-1        Rem to the screen, so max out at text width
    ENDIF
    IF l%>255
        l%=255
    ENDIF
    IF i&(3)>32    Rem limit to 32 number of scanlines
        i&(3)=32
    ENDIF
    xlim&=ADDR(line$)+l%+1
    POKEB ADDR(line$),l%    Rem set length of string
    DO
        gPEEKLINE id%,0,y%,d%(),l%
        bit%=1
        c%=1
        a&=ADDR(line$)+1
        DO
            IF d%(c%) AND bit%
                POKEB a&,ch%
                flag%=1
            ELSE
                POKEB a&,32
            ENDIF
            bit%=UADD(bit%,bit%)
            IF bit%=0
                bit%=1
                c%=c%+1
            ENDIF
            a&=a&+1
        UNTIL a&>xlim&
        IF flag%                Rem Something was printed on this line
            WHILE count%                Rem count% is number of empty lines
                fprint%:("")
                count%=count%-1    Rem this auto-magically sets count%=0
            ENDWH
            fprint%:(line$)
            flag%=0
        ELSE
            count%=count%+1
        ENDIF
        y%=y%+1
    UNTIL y%=i&(3)
    gCLOSE id%
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    IF id%
        gCLOSE id%
    ENDIF
    RETURN ERR
ENDP

PROC bg%:(n%)
    SETBACKGROUND:
ENDP

PROC bindkey%:(n%)
LOCAL c%,i%,char$(255),buf$(255),d$(255),f%,mod%,args%,sep%
LOCAL l%,dkeys$(20),keys$(10,6),vkeys$(30)
    keys$(1)="left"
    keys$(2)="right"
    keys$(3)="up"
    keys$(4)="down"
    keys$(5)="menu"
    keys$(6)="delete"
    keys$(7)="enter"
    keys$(8)="space"
    keys$(9)="esc"
    keys$(10)="tab"
    vkeys$="391392393394438008013032027009"
    dkeys$="08070506000103320413"
    ONERR ErrTrap::
    IF n%=1
        WHILE i%<10
            i%=i%+1
            l%=VAL(MID$(vkeys$,i%*3-2,3))
            IF PEEKB(_keys&+l%) <>  VAL(MID$(dkeys$,i%*2-1,2))
                _kdisp%:(keys$(i%),_gact$:(PEEKB(_keys&+l%)),ADDR(d$))
            ENDIF
            IF l%<=32            Rem only for keys like escape, enter, space
                IF PEEKB(_keys&+l%+256)
                    _kdisp%:("Shift-"+keys$(i%),_gact$:(PEEKB(_keys&+l%+256)),ADDR(d$))
                ENDIF
            ENDIF
        ENDWH
        i%=1
        WHILE i%<27        Rem check for Ctrl-?
            IF PEEKB(_keys&+i%) AND i%<>9 AND i%<>13 AND i%<>8
                _kdisp%:("Ctrl-"+CHR$(i%+96),_gact$:(PEEKB(_keys&+i%)),ADDR(d$))
            ENDIF
            IF PEEKB(_keys&+$100+i%) AND i%<>8            Rem delete-right
                _kdisp%:("Shift-Ctrl-"+CHR$(i%+96),_gact$:(PEEKB(_keys&+$100+i%)),ADDR(d$))
            ENDIF
            IF PEEKB(_keys&+$100+i%+96)
                _kdisp%:("Fn-"+CHR$(i%+96),_gact$:(PEEKB(_keys&+$100+i%+96)),ADDR(d$))
            ENDIF
            IF PEEKB(_keys&+$100+i%+64)
                _kdisp%:("Shift-Fn-"+CHR$(i%+96),_gact$:(PEEKB(_keys&+$100+i%+64)),ADDR(d$))
            ENDIF
            i%=i%+1
        ENDWH
        IF LEN(d$)
            fprint%:(d$)
        ENDIF
        i%=1
        WHILE i%<17
            buf$=GetVar$:("macro"+NUM$(i%,2))
            IF LEN(buf$)
                IF f%=0    Rem first one found
                    fprint%:("")
                    f%=1
                ENDIF
                fprint%:(PrFmt$:("macro"+NUM$(i%,2),8)+buf$)
            ENDIF
            i%=i%+1
        ENDWH
    ELSE    Rem n%>1
        args%=2
        DO
            mod%=0
            char$=PEEK$(argv&(args%))
            sep%=LOC(char$,":")
            IF sep%
                char$=LEFT$(char$,sep%-1)
            ENDIF
            i%=LOC(char$,"-")
            WHILE i%
                buf$=LOWER$(LEFT$(char$,i%-1))
                IF buf$="shift"
                    mod%=mod% OR $1
                ELSEIF buf$="ctrl"
                    mod%=mod% OR $2
                ELSEIF buf$="fn"
                    mod%=mod% OR $4
                ELSE
                    buf$="Unknown modifier """+LEFT$(char$,i%-1)+""". Only Fn-, Shift- or Ctrl- are recognized"
                    GOTO Err::
                ENDIF
                char$=RIGHT$(char$,LEN(char$)-i%)
                i%=LOC(char$,"-")
            ENDWH
            IF (mod% AND $6)=$6
                buf$="Cannot have both Fn- and Ctrl- modifiers."
                GOTO Err::
            ENDIF
            i%=1
            WHILE i%<11
                IF LOWER$(char$)=keys$(i%)
                    c%=VAL(MID$(vkeys$,i%*3-2,3))
                    IF mod% AND $6                Rem special keys can only take shift modifiers
                        buf$="This key may only accept a Shift- modifier."
                        GOTO Err::
                    ENDIF
                    IF mod%                            Rem can only be shift
                        IF c%>32
                            buf$="This key can't take the Shift- modifier."
                            GOTO Err::
                        ELSE
                            c%=c%+256
                        ENDIF
                    ENDIF
                    GOTO Foundc::
                ENDIF
                i%=i%+1
            ENDWH
            IF LEN(char$)=1 AND mod%
                c%=ASC(LOWER$(char$))
            ELSEIF ASC(char$)=%#
                c%=VAL(RIGHT$(char$,LEN(char$)-1))
                GOTO Foundc::
            ELSE
                buf$="Key not recognised"
                GOTO Err::
            ENDIF
            IF c%<%a OR c%>%z OR mod%=$1
                buf$="This key can't accept this modifier."
                GOTO Err::
            ENDIF
            IF mod% AND $2                Rem Ctrl
                c%=c%-96                        Rem "a" -> 1, etc
                IF mod% AND $1            Rem shift too
                    c%=c% + 256
                ENDIF
            ELSEIF mod% AND $4    Rem can't be both Ctrl- and Fn-
                c%=c%+256
                IF mod% AND $1
                    c%=c% - 32                Rem lower to upper case
                ENDIF
            ENDIF
Foundc::
Rem c% Now contains 0-511, the keycode that is to be redefined
Rem        IF c%<0 OR c%>511
Rem            RAISE -7
Rem        ENDIF
            IF sep%=0            Rem only have 1st part, just display the current value
                _kdisp%:(PEEK$(argv&(args%)),_gact$:(PEEKB(_keys&+c%)),ADDR(d$))
            ELSE
                char$=RIGHT$(PEEK$(argv&(args%)),PEEKB(argv&(args%))-sep%)
                i%=0
                IF LEN(char$)=1    Rem single key
                    i%=ASC(char$)    Rem redefine as a simple key press
                ELSEIF LEN(char$)            Rem only allow if something is there, else 0
                    char$=LOWER$(char$)
                    i%=1
                    WHILE i%<13
                        IF char$=_act$(i%)
                            GOTO Found::
                        ENDIF
                        i%=i%+1
                    ENDWH
                    Rem not found
                    IF LEFT$(char$,5)="macro"
                        i%=VAL(RIGHT$(char$,LEN(char$)-5))
                        IF i%<1 OR i%>16
                            RAISE -7
                        ENDIF
                        i%=i%+15
                    ELSEIF ASC(char$)=%#    Rem a number??
                        i%=VAL(RIGHT$(char$,LEN(char$)-1))
                    ELSE    Rem auto-set key??
                        Rem find empty key??
                        i%=PEEKB(_keys&+c%)
                        IF i%>15 AND i%<32
                            buf$="macro"+NUM$(i%-15,2)
                            PRINT "Key is already set to:",buf$;", reusing."
                            FreeVar%:(buf$)
                            SetVar%:(buf$,char$)
                            GOTO Next::
                        ENDIF
                        i%=0
                        WHILE i%<16
                            i%=i%+1
                            IF LEN(GetVar$:("macro"+NUM$(i%,2)))
                                CONTINUE
                            ENDIF
                            SetVar%:("macro"+NUM$(i%,2),char$)
                            PRINT "Storing """;char$;""" in ""macro";NUM$(i%,2);""""
                            i%=i%+15    Rem set for key i%
                            GOTO Found::
                        ENDWH
                        PRINT "No free macros.."
                        GOTO Next::
                    ENDIF
                ENDIF
Found::
                POKEB _keys&+c%,i%
            ENDIF
Next::
            args%=args%+1
        UNTIL args%>n%
        IF LEN(d$)
            fprint%:(d$)
        ENDIF
    ENDIF
    RETURN
Err::
    PRINT PEEK$(argv&(args%));":",buf$
    GOTO Next::
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
ENDP

PROC cat%:(n%)
rem args=1 read from standard input
rem args>1 foreach argument print it
LOCAL d$(255),txt$(255)
LOCAL handle%,ret%,i%
    ONERR ErrTrap::
    IF n%>1 OR _in%        Rem we have files or stdin
        i%=2
        IF _in%
            handle%=_in%
            GOTO Loop::
        ENDIF
        WHILE i%<=n%
            IOYIELD
            IF _stat%<>-46
                IF _key%(1)=27
                    BREAK
                ELSE
                    KEYA(_stat%,_key%())
                ENDIF
            ENDIF
            ret%=Fparse%:(ADDR(d$),PEEK$(argv&(i%)))
            IF ret%<0
                _Err:(i%,ret%)
            ELSEIF ret% AND 16    Rem directory
                _Err:(i%,3)
            ELSE
                Rem open=$0000, text=$0020, share=$0400
                ret%=IOOPEN(handle%,d$,$0420)
                IF ret%<0
                    _Err:(i%,ret%)
                ELSE
Loop::            WHILE 1
                        IOYIELD
                        IF _stat%<>-46
                            IF _key%(1)=27
                                IF handle%<>_in%
                                    IOCLOSE(handle%)
                                ENDIF
                                RETURN
                            ELSE
                                KEYA(_stat%,_key%())
                            ENDIF
                        ENDIF
                        ret%=IOREAD(handle%,ADDR(txt$)+1,255)
                        IF ret% = -36        Rem EOF
                            BREAK
                        ELSEIF ret%<0
                            _Err:(i%,ret%)
                        ELSE
                            POKEB ADDR(txt$),ret%
                            fprint%:(txt$)
                        ENDIF
                    ENDWH
                    IF _in%<>handle%
                        IOCLOSE(handle%)                                Rem what's the point in
                    ENDIF
                ENDIF
            ENDIF
            i%=i%+1
        ENDWH
    ELSE
rem    Input from command line
        DO
            d$=""
            TRAP EDIT d$
            IF ERR=-114    Rem escape key
                BREAK
            ENDIF
            fprint%:(d$)
        UNTIL 0
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC cd%:(n%)
    ONERR ErrTrap::
    IF n%<>2
        PRINT "Usage: cd <directory>"
        RETURN -2
    ENDIF
    _cd%:(PEEK$(argv&(2)))
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC chmod%:(n%)
LOCAL i%,buf$(255),flagSet&,ret%,bits%
    ONERR ErrTrap::
Rem 3 or more args. Arg 2 = absolute flags or - unset or + set
Rem firsr work out attribute changes
    IF n%<3
Usage::
        PRINT "Usage: chmod [+¦-][RHS] <filename>"
        RETURN -2
    ENDIF
    buf$=UPPER$(PEEK$(argv&(2)))
    IF ASC(buf$)=%+
        flagSet&=1
    ELSEIF ASC(buf$)<>%-
        GOTO Usage::
    ENDIF
    WHILE LEN(buf$)-1
        buf$=RIGHT$(buf$,LEN(buf$)-1)
        ret%=ASC(buf$)
        IF ret%=%R
            bits%=bits% OR 1
        ELSEIF ret%=%H
            bits%=bits% OR 2
        ELSEIF ret%=%S
            bits%=bits% OR 4
        ELSE
Rem            PRINT "Bad attribute:",CHR$(ret%)
            GOTO Usage::
        ENDIF
    ENDWH
    i%=3
    WHILE i%<=n%
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(i%)))
        IF ret%<0
            _Err:(i%,ret%)
        ELSE
            IF bits% AND $0001            Rem read-only
                SETREADONLY:(buf$,flagSet&)
            ENDIF
            IF bits% AND $0002            Rem hidden
                SETHIDDENFILE:(buf$,flagSet&)
            ENDIF
            IF bits% AND $0004            Rem system
                SETSYSTEMFILE:(buf$,flagSet&)
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC cls%:(n%)
    CLS
ENDP

PROC cp%:(n%)
    ONERR ErrTrap::
    IF n%<3
        PRINT "Usage: cp <source> <destination>"
        RETURN -2
    ENDIF
    _cpmv%:(n%,0)
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC date%:(n%)
    fprint%:(DATIM$)
ENDP

PROC df%:(n%)
LOCAL p&,drive&,d$(9),buf$(81),id$(8)
    ONERR ErrTrap::
    buf$="No media Unknown  Floppy   Hard diskCD-ROM   RAM      Flash    ROM      Remote   "
    p&=PEEKL(_dirB&)
    fprint%:("Drive   Type       ID      Capacity     Used       Free")
    fprint%:(REPT$("ΓÇö",57))
    WHILE p&
        drive&=PEEKB(p&+5)-%A                Rem first character of pathname
        d$=MID$(buf$,(MEDIATYPE&:(drive&)*9)+1,9)
        id$=HEX$(VOLUMEUNIQUEID&:(drive&))
        fprint%:("  "+CHR$(drive&+%A)+"   "+d$+REPT$(" ",9-LEN(id$))+id$+NUM$(VOLUMESIZE&:(drive&),-8)+" KB"+NUM$(VOLUMESIZE&:(drive&)-VOLUMESPACEFREE&:(drive&),-8)+" KB"+NUM$(VOLUMESPACEFREE&:(drive&),-8)+" KB")
        p&=PEEKL(p&)
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC dirs%:(n%)
LOCAL p&
    ONERR ErrTrap::
Rem initially, takes no arguments, COULD enhance later
    p&=_pushc&
    PRINT PrPath$:(_cwd$),
    IF p&
        DO
            PRINT PrPath$:(PEEK$(p&+8)),
            p&=PEEKL(p&+4)
        UNTIL p&=_pushc&                Rem until it loops round
    ENDIF
    PRINT
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC echo%:(n%)
LOCAL i%,buf$(255)
    ONERR ErrTrap::
    i%=2
    WHILE i%<=n%
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        IF LEN(buf$)+LEN(PEEK$(argv&(i%))) >= 254    Rem test for overflow
            fprint%:(buf$)
            buf$=""
        ENDIF
        buf$=buf$+PEEK$(argv&(i%))
        i%=i%+1
        IF i%<=n%    Rem add " " unless it's the last entry
            buf$=buf$+" "
        ENDIF
    ENDWH
    fprint%:(buf$)
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC edit%:(n%)
LOCAL ret%,buf$(255),h%,size&,p&,base&,end&,c%,eol&,App&
    ONERR ErrTrap::
    IF n%<>2
        PRINT "Usage: edit <filename>"
        RETURN
    ENDIF
    eol&=&00000A0D            Rem 0D0A
Rem get thread ID of running process, so that a keypress event can be
Rem sent later. NOTE: this won't work if multiple shells are running!
    App&=GetThreadIDFromAppUID&:(ShellUID&,p&)
    ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(2)))
    IF ret%=0                                                        Rem ordinary file
        ret%=IOOPEN(h%,buf$,$0600)                Rem random access opening first
        IF ret%
            RAISE ret%
        ENDIF
        IOSEEK(h%,2,size&)                                Rem get size
        IOCLOSE(h%)
        h%=0
    ELSEIF ret%<>-33                                        Rem No such file, so we'll create
        RAISE 3            Rem not a plain file - could be directory, or something else
    ENDIF
    base&=ALLOC(size&+8192)            Rem increase this to 8192 say?
Rem    base&=ALLOC&:(size&+8192,"edit")            Rem increase this to 8192 say?
    IF base&=0
        RAISE -10
    ENDIF
    IF size&                                                    Rem existing non-zero file
        p&=base&+4
        ret%=IOOPEN(h%,buf$,$0020)                    Rem sequential access
        IF ret%
            RAISE ret%
        ENDIF
        DO
            ret%=IOREAD(h%,p&,255)
            IF ret%<0
                IF ret%=-36
                    BREAK
                ELSE
                    RAISE ret%
                ENDIF
            ELSE
                p&=p&+ret%+1
                POKEB p&-1,6                            Rem end of line in dEDITMULTI
            ENDIF
        UNTIL 0                                Rem break out above
        POKEL base&,p&-base&-4                Rem actual chars in buffer
        IOCLOSE(h%)
        h%=0
    ELSE
        POKEL base&,0                                Rem no data
    ENDIF
    dINIT "",$1F
    dEDITMULTI base&,"",80,10,size&+8188        Rem 4 bytes LESS than was allocated
    dBUTTONS "Save",%s,"Cancel",27                Rem 27=Escape
Rem send the application an uparrow event (keycode 4105, scan 16)
Rem this deselects the file contents and moves cursor to top of file.
    SendKeyEventToApp&:(App&,0,4105,16,0,0)
    ret%=DIALOG
    IF ret%<>%s                                            Rem not saving, so ask for confirmation
        dINIT "Confirm discard of edits",0
        dBUTTONS "No",%n+$100,"Yes",%y+$100
        ret%=DIALOG
    ENDIF
    IF ret%=%s OR ret%=%n                    Rem save (%n from no to discard edits)
Rem write out new buffer
        PRINT "Saving",PrPath$:(buf$)
        ret%=IOOPEN(h%,buf$,$0302)
        IF ret%
            RAISE ret%
        ENDIF
        p&=base&+4
        end&=p&+PEEKL(base&)
        WHILE p& <= end&
            IF (PEEKB(p&)=6) OR c%=253 OR p&=end&
Rem newline in dialog or max characters or last character
                IOWRITE(h%,p&-c%,c%)
                IF p&<>end&
                    IOWRITE(h%,ADDR(eol&),2)        Rem 0D0A
                ENDIF
                c%=-(c%=253 AND PEEKB(p&)<>6)            Rem we use this character
            ELSE
                c%=c%+1
            ENDIF
            p&=p&+1
        ENDWH
        IOCLOSE(h%)
    ENDIF
Rem    FREEALLOC&:(base&)
    FREEALLOC(base&)
    RETURN
ErrTrap::
    ONERR off
    IF h%
        IOCLOSE(h%)
    ENDIF
    IF base&
Rem        FREEALLOC&:(base&)
        FREEALLOC(base&)
    ENDIF
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC exit%:(n%)
LOCAL ret%
    ONERR ErrTrap::
    IF n%>2
        PRINT "Usage: exit [code]"
        RETURN -2
    ELSEIF n%=2
        ret%=VAL(PEEK$(argv&(2)))
    ENDIF
    Rem flag it's an exit
    POKEB _curr&+PR_FLAG%,1
    RETURN ret%
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC hash%:(n%)
LOCAL p&,q&,buf$(255),i%,flag%,in$(255)
    ONERR ErrTrap::
    i%=2
    IF n%>1
        IF PEEK$(argv&(2))="-r"
            IF n%=2                                Rem no more arguments!
                p&=PEEKL(_hash&)        Rem clear hash table
                WHILE p&
                    q&=p&
                    p&=PEEKL(p&)
                    FREEALLOC(q&)
                ENDWH
                POKEL _hash&,0
                RETURN
            ELSE
                flag%=1
                i%=3
            ENDIF
        ENDIF
        IF n%>i%
            PRINT "Usage: hash [-r] [command]"
            RETURN -2
        ENDIF
    ENDIF
    p&=_hash&
    IF i%>n%    Rem ran out of arguments, so show all entries
        WHILE PEEKL(p&)
            p&=PEEKL(p&)
            buf$=PEEK$(p&+4)
            fprint%:(PrFmt$:(buf$,14)+PrPath$:(PEEK$(p&+LEN(buf$)+5)))
        ENDWH
    ELSE    Rem display or remove a single entry
        in$=PEEK$(argv&(i%))
        i%=LOC(in$,".")
        WHILE PEEKL(p&)
            q&=p&
            p&=PEEKL(p&)
            buf$=PEEK$(p&+4)
            IF i%    Rem found some "." so do an exact match
                IF LOWER$(buf$)=LOWER$(in$)
                    Goto Found::
                ENDIF
            ELSE
                IF in$=LEFT$(buf$,LEN(buf$)-4)
Found::        IF flag%
                        POKEL q&,PEEKL(p&)
                        FREEALLOC(p&)
Rem                        FREEALLOC&:(p&)
                        RETURN
                    ELSE
                        fprint%:(PrFmt$:(buf$,14)+PrPath$:(PEEK$(p&+LEN(buf$)+5)))
                        RETURN
                    ENDIF
                ENDIF
            ENDIF
        ENDWH
        PRINT "Command not in the hashed list"
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC help%:(n%)
Rem with no arguements, searches for shell5.hlp
Rem with an arguments searches for argument.hlp
Rem keeps a linked list of help files open (with associated thread ID's)
LOCAL file$(255),sep%,ret%,buf$(255),d$(255),p&,attr%(8),q&
    ONERR ErrTrap::
    IF n%=1
        file$="shell5"
        GOTO Search::
    ELSEIF n%=2
        file$=LOWER$(PEEK$(argv&(2)))
        IF file$="-l"
            file$=GetVar$:("helppath")+","
            WHILE LEN(file$)
                sep%=LOC(file$,",")
                ret%=Fparse%:(ADDR(buf$),LEFT$(file$,sep%-1))
                IF (ret%<0) OR ((ret% AND 16)=0)    Rem Not directory
                    _log:(3,"Bad helppath component:  "+LEFT$(file$,sep%-1))
                ELSE
                    d$=DIR$(buf$+"*.hlp")
                    WHILE LEN(d$)
                        fprint%:(RIGHT$(d$,LEN(d$)-LEN(buf$)))
                        d$=DIR$("")
                    ENDWH
                ENDIF
                file$=RIGHT$(file$,LEN(file$)-sep%)
            ENDWH
        ELSE
Search::            Rem search for file$ in list of open help files first
            p&=_help&
            WHILE PEEKL(p&)                Rem this way so p& is valid after loop
                q&=p&                                Rem previous entry
                p&=PEEKL(p&)
                IF PEEK$(p&+8)=file$
                    ONERR Restart::
                    SETFOREGROUNDBYTHREAD&:(PEEKL(p&+4),0)
                    GOTO End::                    Rem nothing else to do, valid thread
Restart::        ONERR ErrTrap::            Rem thread no longer around, retry
                    POKEL q&,PEEKL(p&)    Rem glue to the next entry
                    FREEALLOC(p&)        Rem delete current entry
Rem                    FREEALLOC&:(p&)        Rem delete current entry
                    p&=q&
                ENDIF
            ENDWH
            buf$=_path$:(GetVar$:("helppath"),file$,"hlp")
            IF LEN(buf$)
                parse%:(buf$,ADDR(file$),ADDR(attr%()))    Rem this *can't* fail
                file$=MID$(file$,attr%(4),attr%(5)-attr%(4))
                POKEL p&,ALLOC((LEN(file$)+24) AND $FFF0)
Rem                POKEL p&,ALLOC&:(((LEN(file$)+24) AND $FFF0),"nman1")
                Rem 4+4+LEN+1+15
                IF PEEKL(p&)=0
                    RAISE -10
                ENDIF
                p&=PEEKL(p&)
                POKEL p&,0
                POKE$ p&+8,file$
                POKEL p&+4,RUNAPP&:("Data",buf$,"",0)
            ELSE
                PRINT "Can't find help file:",file$;".hlp"
            ENDIF
        ENDIF
    ELSE
        PRINT "Usage: help [-l] [help file]"
    ENDIF
End::
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC history%:(n%)
LOCAL p&,i%,Start%
    ONERR ErrTrap::
    p&=PEEKL(_hpos&)
    IF n%>2
        PRINT "Usage: history [no. of commands]"
        RETURN -2
    ELSEIF n%=2
        Start%=EVAL(PEEK$(argv&(2)))+1
        Rem check for terms < 0 or larger than the history size
        IF Start%<=_hrsz% AND Start%>0
            i%=_hnum%-Start%+2
            DO
                p&=PEEKL(p&+4)
                Start%=Start%-1
            UNTIL Start%=0
            GOTO Show::
        ENDIF
    ENDIF
    i%=_hnum%-_hrsz%+1
Show::
    WHILE p&<>_hpos&
        IF PEEKL(p&+8)
            fprint%:(GEN$(i%,-5)+" "+PEEK$(PEEKL(p&+8)))
        ENDIF
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        p&=PEEKL(p&)
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC log%:(n%)
LOCAL i%,buf$(255)
    ONERR ErrTrap::
    IF n%=1
        IF _logid%=0
            _log:(1,"")    Rem if the log isn't displayed, display it
        ENDIF
    ELSE
        buf$=PEEK$(argv&(2))
        IF buf$="-t"
            _log:((_logid%=0)+2,"")
        ELSEIF buf$="-c"
            _log:(7,"")
        ELSEIF buf$="-b"
            _log:(5,"")
        ELSEIF buf$="-f"
            _log:(6,"")
        ELSEIF buf$="-r"
            _log:(2,"")
        ELSEIF buf$="-a" AND n%=3
            _log:(4,PEEK$(argv&(3)))
        ELSEIF n%=2
            _log:(3,buf$)
        ELSE
            PRINT "Usage: log [-c¦-b¦-f¦-r¦-a¦-t] [""message""]"
        ENDIF
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC ls%:(n%)
LOCAL buf$(255),d$(255),ret%,attr%(8),dispFL%,i%,len%,usage&
LOCAL dlist&,dcurr&,p&,j%,m%,q&,sep$(1),h%,dbuf$(255),Fsize&,date&
LOCAL x%,Files%,pm$(2),dir%
    ONERR ErrTrap::
    i%=2
    WHILE i%<=n%
        buf$=PEEK$(argv&(i%))
        IF buf$="-l"
            dispFL%=1                Rem full info
        ELSEIF buf$="-s"
            dispFL%=2                Rem summary type info
        ELSE
            BREAK
        ENDIF
        i%=i%+1
    ENDWH
    IF i%>n%
        buf$=_cwd$
    ENDIF
    IF _opts%(varUNIXpath%)
        sep$="/"
    ELSE
        sep$="\"
    ENDIF
    date&=DTNOW&:                Rem create date/time object
    DO
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                GOTO Tidy::
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        usage&=0
        Files%=0
        ret%=parse%:(buf$,ADDR(buf$),ADDR(attr%()))
        IF ret%>=0 AND attr%(6)=0            Rem no wildcards
            ret%=stat%:(ADDR(buf$))
        ENDIF
        IF ret%<0
            IF i%>n%    Rem no directories given
                PRINT err$:(ret%)
            ELSE
                _Err:(i%,ret%)
            ENDIF
            GOTO Next::
        ELSEIF ret% AND 16        Rem directory
            len%=LEN(buf$)
            dbuf$="[Listing of "+PrPath$:(buf$)+"]"
Rem            fprint%:("[Listing of "+PrPath$:(buf$)+"]")
            dir%=1
        ELSE                                    Rem file
            len%=attr%(4)-1        Rem length of last part of the filename
            dir%=0
            dbuf$=""
        ENDIF
        d$=DIR$(buf$)
Rem empty - either empty directory or null wildcard
Rem initialize the display list
        dlist&=ALLOC(16)
Rem        dlist&=ALLOC&:(16,"ls1")
        IF dlist&=0
            RAISE -10        Rem no memory
        ENDIF
        POKEL dlist&,0                Rem clear "next" pointer
        dcurr&=dlist&                    Rem current position in display list
        POKEW dlist&+4,0        Rem set max width=0
        WHILE LEN(d$)
            IOYIELD
            IF _stat%<>-46
                IF _key%(1)=27
                    GOTO Tidy::
                ELSE
                    KEYA(_stat%,_key%())
                ENDIF
            ENDIF
            d$=RIGHT$(d$,LEN(d$)-len%)
            POKEL dcurr&,ALLOC((LEN(d$)+20) AND $FFF0)
Rem            POKEL dcurr&,ALLOC&:((LEN(d$)+20) AND $FFF0,"expand2")
Rem length of file$ + 1 + 15 for 16 byte boundry + long pointer
            IF PEEKL(dcurr&)=0
                RAISE -10
            ENDIF
            IF LEN(d$)>PEEKW(dlist&+4)
                POKEW(dlist&+4),LEN(d$)
            ENDIF
            dcurr&=PEEKL(dcurr&)
            POKEL dcurr&,0                                    Rem clear next
            POKE$ dcurr&+4,d$
            d$=DIR$("")
        ENDWH
        IF dispFL%                                                    Rem summary or long listing
            j%=PEEKW(dlist&+4)+8                            Rem space for size an <DIR>
        ELSE
            j%=PEEKW(dlist&+4)+2                            Rem space for size an <DIR>
        ENDIF
        m%=j%
        p&=PEEKL(dlist&)
        IF LEN(dbuf$)
            fprint%:(dbuf$)                                            Rem listing of...
            dbuf$=""
        ENDIF
        WHILE p&
            d$=PEEK$(p&+4)
            dbuf$=dbuf$+d$
            ret%=IOOPEN(h%,LEFT$(buf$,len%)+d$,$0600)    Rem read-only, shared, random access
            IF ret%=0
                IF dispFL%
                    Fsize&=0
                    IOSEEK(h%,2,Fsize&)
Rem                    Fsize&=GetFileSize&:(LEFT$(buf$,len%)+d$)
                    Files%=Files%+1
                    Usage&=Usage&+Fsize&
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$)-8)
                    IF dispFL%=2                    Rem summary
                        IF Fsize&<100000
                            dbuf$=dbuf$+NUM$(Fsize&,-6)+"  "
                        ELSEIF Fsize&>10000000
                            dbuf$=dbuf$+NUM$(Fsize&/10000000,-5)+"  M"
                        ELSE
                            dbuf$=dbuf$+NUM$(Fsize&/1000,-5)+"K  "
                        ENDIF
                    ELSE
                        dbuf$=dbuf$+NUM$(Fsize&,-10)
                    ENDIF
                ELSE
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$))
                ENDIF
                IOCLOSE(h%)        Rem ret%=0, -9 is handled differently now
                h%=0
            ELSEIF ret%=-9            Rem in use
                IF dispFL%=0
                    dbuf$=dbuf$+"#"+REPT$(" ",j%-LEN(d$)-1)
                ELSEIF dispFL%=2            Rem summary
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$)-8)+"<OPEN>  "
                ELSE                                    Rem full listing
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$)-8)+"  <IN USE>"
                ENDIF
            ELSE
                IF dispFL%=0
                    dbuf$=dbuf$+sep$+REPT$(" ",j%-LEN(d$)-1)
                ELSEIF dispFL%=2                        Rem summary listing
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$)-8)+" <DIR>  "
                ELSE
                    dbuf$=dbuf$+REPT$(" ",j%-LEN(d$)-8)+"     <DIR>"
                ENDIF
            ENDIF
            IF dispFL%=1        Rem print attributes and date
                d$=LEFT$(buf$,len%)+d$    Rem absolute pathname
                IF ISREADONLY&:(d$)
                    dbuf$=dbuf$+"  R"
                ELSE
                    dbuf$=dbuf$+"  -"
                ENDIF
                IF ISHIDDEN&:(d$)
                    dbuf$=dbuf$+"H"
                ELSE
                    dbuf$=dbuf$+"-"
                ENDIF
                IF ISSYSTEM&:(d$)
                    dbuf$=dbuf$+"S"
                ELSE
                    dbuf$=dbuf$+"-"
                ENDIF
                GETFILETIME:(d$,date&)
                x%=DTHour&:(date&)
                IF x%>11
                    x%=x%-12
                    pm$="pm"
                ELSE
                    pm$="am"
                ENDIF
                IF x%=0
                    x%=12
                ENDIF
                dbuf$=dbuf$+NUM$(x%,-4)+":"
                x%=DTMinute&:(date&)
                dbuf$=dbuf$+CHR$(x%/10+48)+CHR$(x%-(x%/10)*10+48)+pm$
                dbuf$=dbuf$+NUM$(DTDay&:(date&),-3)+"-"+MONTH$(DTMonth&:(date&))+NUM$(DTYear&:(date&),-5)
                fprint%:(dbuf$)
                dbuf$=""
            ELSE
                m%=m%+j%
                IF m%>=ScrInfo%(3)
                    fprint%:(dbuf$)
                    dbuf$=""
                    m%=j%
                ENDIF
            ENDIF
            IOYIELD
            IF _stat%<>-46
                IF _key%(1)=27
                    GOTO Tidy::
                ELSE
                    KEYA(_stat%,_key%())
                ENDIF
            ENDIF
            p&=PEEKL(p&)
        ENDWH
        p&=PEEKL(dlist&)        Rem do this separately so if an err or ESC happens
        WHILE p&                        Rem the clean-up routine will actually work!!
            q&=PEEKL(p&)
            FREEALLOC(p&)
Rem            FREEALLOC&:(p&)
            p&=q&
        ENDWH
        FREEALLOC(dlist&)
Rem        FREEALLOC&:(dlist&)
        dlist&=0
        IF m%<>j%
            fprint%:(dbuf$)
        ENDIF
        IF dir% AND (dispFl%<>0)        Rem size only recorded in -s or -l modes
            fprint%:(NUM$(Files%,4)+" File(s), "+NUM$(usage&,10)+" Bytes,"+NUM$(VOLUMESPACEFREE&:(ASC(buf$)-%A),10)+" KB free.")
        ENDIF
Next::
        i%=i%+1
        IF i%<=n%
            buf$=PEEK$(argv&(i%))
        ENDIF
    UNTIL i%>n%
    DTDELETEDATETIME:(date&)
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
Tidy::
    IF date&
        DTDELETEDATETIME:(date&)
    ENDIF
    IF h%
        IOCLOSE(h%)
    ENDIF
    IF dlist&
        p&=PEEKL(dlist&)
        WHILE p&
            q&=PEEKL(p&)
            FREEALLOC(p&)
Rem            FREEALLOC&:(p&)
            p&=q&
        ENDWH
        FREEALLOC(dlist&)
Rem        FREEALLOC&:(dlist&)
        dlist&=0
    ENDIF
    RETURN ERR
ENDP

PROC mkdir%:(n%)
LOCAL i%,buf$(255),ret%
    ONERR ErrTrap::
    i%=2
    IF n%<2
        PRINT "Usage: mkdir <directory>"
        RETURN -2
    ENDIF
    WHILE i%<=n%
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(i%)))
        IF ret%<0 AND ret%<>-33
            _Err:(i%,ret%)
        ELSE
            TRAP MKDIR buf$
            IF ERR
                _Err:(i%,ERR)
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC more%:(n%)
    LOCAL txt$(255),d$(255)
    LOCAL handle%,ret%,row%,key%,i%,files%
    ONERR ErrTrap::
    IF n%<2 AND _in%=0
        PRINT "Usage: more <filename>"
        RETURN -2
    ENDIF
    i%=2
    IF n%=1 AND _in%    Rem only stdin
        handle%=_in%
        row%=1
        GOTO loop::
    ENDIF
    WHILE i%<=n%
        ret%=Fparse%:(ADDR(d$),PEEK$(argv&(i%)))
        IF ret%<0
            _Err:(i%,ret%)
        ELSEIF ret% AND 16    Rem this is a directory
            _Err:(i%,3)
        ELSE
            IF files%
                PRINT
                AT 1,ScrInfo%(4)
                STYLE _style% OR $4
                PRINT "Next file:";d$
                STYLE _style%
                AT 1,ScrInfo%(4)
                key%=GET
                IF key%=27 OR key%=%q
                    RETURN
                ENDIF
                CLS
            ENDIF
            row%=1
            files%=files%+1
            REM open=$0000, text=$0020, share=$0400
            ret%=IOOPEN(handle%,d$,$0420)
            IF ret%<0
                _Err:(i%,ret%)
            ELSE
Loop::        WHILE 1
                    IOYIELD
                    IF _stat%<>-46
                        IF _key%(1)=27
                            GOTO quit::
                        ELSE
                            KEYA(_stat%,_key%())
                        ENDIF
                    ENDIF
                    ret%=IOREAD(handle%,ADDR(txt$)+1,255)
                    IF ret%<0
                        IF ret%<>-36                REM not EOF
                            RAISE ret%
                        ENDIF
                        BREAK
                    ENDIF
                    POKEB ADDR(txt$),ret%
                    PRINT txt$
                    row%=row%+1
                    IF row%>=ScrInfo%(4)
                        STYLE _style% OR $4
                        PRINT "<MORE>";PrPath$:(d$)
                        STYLE _style%
                        AT 1,ScrInfo%(4)
                        key%=GET
                        IF key%=27 OR key%=%q
                            GOTO quit::
                        ELSEIF key%=13
                            row%=row%-1
                        ELSEIF key%=%n
                            BREAK
                        ELSE
                            row%=1
                        ENDIF
                        PRINT REPT$(" ",ScrInfo%(3))    Rem blank out <More>...
                        AT 1,ScrInfo%(4)
                    ENDIF
                ENDWH
                IF handle%<>_in%
                    IOCLOSE(handle%)
                ENDIF
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
quit::
    IF handle%<>_in%
        IOCLOSE(handle%)
    ENDIF
    RETURN ERR
ENDP

PROC mv%:(n%)
    ONERR ErrTrap::
    IF n%<3
        PRINT "Usage: mv <source> <destination>"
        RETURN -2
    ENDIF
    _cpmv%:(n%,1)
    RETURN ERR
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC od%:(n%)
LOCAL d$(255),h$(255),char$(42),input$(255),c%
LOCAL handle%,ret%,row%,key%,i%,files%,items%,j%,offset%
    ONERR ErrTrap::
    IF n%<2 AND _in%=0
        PRINT "Usage: od <filename>"
        RETURN -2
    ENDIF
    i%=2
    items%=(ScrInfo%(3)-2)/4    Rem columns
    offset%=ScrInfo%(3)-items%-1
    IF _in%
        row%=1
        handle%=_in%
        GOTO loop::
    ENDIF
    WHILE i%<=n%
        ret%=Fparse%:(ADDR(d$),PEEK$(argv&(i%)))
        IF ret%<0
            _Err:(i%,ret%)
            GOTO Next::
        ELSEIF ret% AND 16    Rem this is a directory
            _Err:(i%,3)
            GOTO Next::
        ENDIF
        IF files%
            PRINT
            AT 1,ScrInfo%(4)
            STYLE _style% OR 4
            PRINT "Next file:";d$
            STYLE _style%
            AT 1,ScrInfo%(4)
            key%=GET
            IF key%=27 OR key%=%q
                RETURN
            ENDIF
            CLS
        ENDIF
        row%=1
        files%=1
        REM open=$0000, binary=$0000, share=$0400
        ret%=IOOPEN(handle%,d$,$0400)
        IF ret%<0
            _Err:(i%,ret%)
        ELSE
loop::    WHILE 1
                j%=items%
                h$=""
                char$=""
                WHILE j%
                    IOYIELD
                    IF _stat%<>-46
                        IF _key%(1)=27
                            GOTO quit::
                        ELSE
                            KEYA(_stat%,_key%())
                        ENDIF
                    ENDIF
                    IF LEN(input$)=0    Rem end of last line
                        ret%=IOREAD(handle%,ADDR(input$)+1,255)
                        IF ret%<0
                            IF ret%<>-36
                                RAISE ret%
                            ELSE
                                IF LEN(h$)
                                    PRINT h$+REPT$(" ",offset%-LEN(h$))+char$
                                ENDIF
                                GOTO Endfile::
                            ENDIF
                        ENDIF
                        POKEB ADDR(input$),ret%
                        IF _in%    Rem stdin - text rather than binary
                            input$=input$+CHR$(13)+CHR$(10)    Rem add linefeed/newline
                        ENDIF
                    ENDIF
                    c%=ASC(input$)
                    input$=RIGHT$(input$,LEN(input$)-1)
                    IF c%<16
                        h$=h$+"0"
                    ENDIF
                    h$=h$+HEX$(c%)+" "
                    IF c%<32
                        c%=%?
                    ENDIF
                    char$=char$+CHR$(c%)
                    j%=j%-1
                ENDWH
                PRINT h$+REPT$(" ",offset%-LEN(h$))+char$
                row%=row%+1
                IF row%>=ScrInfo%(4)
                    STYLE _style% OR $4
                    PRINT "<OD>";PrPath$:(d$)
                    STYLE _style%
                    AT 1,ScrInfo%(4)
                    key%=GET
                    IF key%=27 OR key%=%q
                        GOTO quit::
                    ELSEIF key%=13
                        row%=row%-1
                    ELSEIF key%=%n
                        BREAK
                    ELSE
                        row%=1
                    ENDIF
                    PRINT REPT$(" ",ScrInfo%(3))    Rem blank out <Od>...
                    AT 1,ScrInfo%(4)
                ENDIF
            ENDWH
EndFile::
            IF handle%<>_in%
                IOCLOSE(handle%)
            ENDIF
        ENDIF
Next::
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
quit::
    IF handle%<>_in%
        IOCLOSE(handle%)
    ENDIF
    RETURN ERR
ENDP

PROC pause%:(n%)
    ONERR ErrTrap::
    IF n%=1
        PAUSE 0
    ELSEIF n%=2
        PAUSE VAL(PEEK$(argv&(2)))
    ELSE
        PRINT "Usage: pause [interval]"
        RETURN -2
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC popd%:(n%)
LOCAL p&,old$(255)
    ONERR ErrTrap::
    IF _pushc&
        p&=PEEKL(_pushc&+4)
        old$=PEEK$(_pushc&+8)
        POKEL PEEKL(_pushc&)+4,p&        Rem glue next previous
        POKEL p&,PEEKL(_pushc&)                Rem glue previous next
        FREEALLOC(_pushc&)
Rem        FREEALLOC&:(_pushc&)
        IF p&=_pushc&
            _pushc&=0
        ELSE
            _pushc&=p&
        ENDIF
        _cd%:(old$)
    ELSE
        PRINT "directory stack empty"
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT ERR$(ERR)
    RETURN ERR
ENDP

Rem this code is really rather nasty in places!!
PROC pushd%:(n%)
LOCAL p&,d$(255),q&,old$(255),i%,newp&
    ONERR ErrTrap::
    IF n%<>2
        PRINT "Usage: pushd <+n¦-n¦directory>"
        RETURN
    ENDIF
    d$=PEEK$(argv&(2))
    p&=_pushc&
    IF ASC(d$)=%-
        IF p&=0
            GOTO Empty::
        ELSE
            i%=EVAL(RIGHT$(d$,LEN(d$)-1))
            p&=PEEKL(p&)
            WHILE (i%>0) AND (p&<>_pushc&)
                i%=i%-1
                p&=PEEKL(p&)
            ENDWH
            IF (p&=_pushc&) AND (i%>0)            Rem we didn't shift all the way....
                IF i%<>1            Rem i%=1 we do nothing, drop out to end
                    GOTO BadIndex::
                ENDIF
            ELSE
                GOTO Del_Old::
            ENDIF
        ENDIF
    ELSEIF ASC(d$)=%+
        IF p&=0
            GOTO Empty::
        ELSE
            i%=EVAL(RIGHT$(d$,LEN(d$)-1))-1
            IF i%>=0
                WHILE i%>0
                    p&=PEEKL(p&+4)
                    IF p&=_pushc&
                        BREAK
                    ENDIF
                    i%=i%-1
                ENDWH
                IF (p&=_pushc&) AND (i%>0)            Rem we didn't shift all the way....
                    GOTO BadIndex::
                ELSE
Del_Old::        old$=_cwd$
                    _cd%:(PEEK$(p&+8))                            Rem if this fails...
                    IF p&=PEEKL(p&)                                        Rem only one entry
                        FREEALLOC(p&)
Rem                        FREEALLOC&:(p&)
                        p&=0
                        newp&=0
                        GOTO Common::
                    ENDIF
                    POKEL PEEKL(p&)+4,PEEKL(p&+4)        Rem glue next previous
                    POKEL PEEKL(p&+4),PEEKL(p&)                Rem glue previous next
                    newp&=PEEKL(p&+4)
                    FREEALLOC(p&)
Rem                    FREEALLOC&:(p&)
                    IF p&=_pushc&
                        p&=newp&
                    ELSE
                        p&=_pushc&
                    ENDIF
                    GOTO Common::
                ENDIF
            ENDIF
        ENDIF
    ELSE
        old$=_cwd$                Rem save current cwd$
        _cd%:(d$)                    Rem this will either work or will have RAISE'd
Common::
        q&=ALLOC((LEN(old$)+24) AND $FFF0)
Rem        q&=ALLOC&:((LEN(old$)+24) AND $FFF0,"pushd1")
        Rem 4+4+LEN(old$)+1+15
        Rem set q& so that if a memory allocation error occurs the list is OK
        IF q&=0
            RAISE -10
        ENDIF
        IF p&                                                    Rem NOT first entry or just shifting
            POKEL q&,PEEKL(p&)                Rem glue to NEXT
            POKEL PEEKL(q&)+4,q&            Rem glue NEXT to here
        ELSE                                                    Rem FIRST entry
            p&=q&
        ENDIF
        POKEL q&+4,p&                            Rem glue to PREVIOUS
        POKEL p&,q&                                Rem glue PREVIOUS to here
        POKE$ q&+8,old$
Rem For -0 and +(n-1), we actually want SH_pushc& to be the new entry..
        IF (newp&<>0) AND (newp&<>_pushc&)
            _pushc&=newp&
        ELSE
            _pushc&=q&                            Rem set new current pointer
        ENDIF
    ENDIF
    dirs%:(1)
End::
    RETURN
BadIndex::
    PRINT d$;": bad directory stack index"
    RETURN
Empty::
    PRINT "Directory stack empty"
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC pwd%:(n%)
    fprint%:(PrPath$:(_cwd$))
ENDP

PROC rename%:(n%)
    LOCAL src$(255),dest$(255),ret%
    ONERR ErrTrap::
    IF n% <> 3
        PRINT "Usage: rename <source> <destination>"
        RETURN -2
    ENDIF
    ret%=Fparse%:(ADDR(src$),PEEK$(argv&(2)))
    IF ret%<0
        _Err:(2,ret%)
        RETURN
    ENDIF
    ret%=Fparse%:(ADDR(dest$),PEEK$(argv&(3)))
    IF ret%<0 AND ret%<>-33
        _Err:(3,ret%)
        RETURN
    ENDIF
    RENAME src$,dest$
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC rescan%:(n%)
Rem delete linked list of connected devices and rescan
LOCAL p&,q&
    ONERR ErrTrap::
    p&=PEEKL(_dirB&)    Rem first element in the list
    WHILE p&
        q&=p&
        p&=PEEKL(p&)    Rem next element
        FREEALLOC q&
Rem        FREEALLOC&:(q&)
    ENDWH
    _nodes:
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC rm%:(n%)
LOCAL flag%,buf$(255),i%,ret%
    ONERR ErrTrap::
    i%=2
    IF n% < 2
        PRINT "Usage: rm [-r] <file1> <file2> ..."
        RETURN
    ELSEIF PEEK$(argv&(2))="-r"
        i%=3
        flag%=1    Rem flag recursive
    ENDIF
    WHILE i%<=n%
        IF flag%                    Rem recursive
            _del%:(PEEK$(argv&(i%)))
        ELSE
            ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(i%)))
            IF ret%<0
                _Err:(i%,ret%)
            ELSEIF ret% AND 16
                _Err:(i%,3)
            ELSE
                IF n%>2
                    PRINT "Deleting",PrPath$:(buf$)
                ENDIF
                TRAP DELETE buf$
                IF ERR
                    _Err:(i%,ERR)
                ENDIF
            ENDIF
        ENDIF
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC rmdir%:(n%)
LOCAL buf$(255),i%,ret%
    ONERR ErrTrap::
    IF n%<2
        PRINT "Usage: rmdir <directory>"
        RETURN -2
    ENDIF
    i%=2
    WHILE i%<=n%
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(i%)))
        IF ret%<0 AND ret%<>-33
            _Err:(i%,ret%)
        ELSE
            TRAP RMDIR buf$
            IF ERR
                _Err:(i%,ERR)
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC set%:(n%)
LOCAL p&,txt$(255),i%,k%,opts$(5,8),set%
    ONERR ErrTrap::
    IF n%=1
        p&=PEEKL(_vars&)
        WHILE p&
            fprint%:(PrFmt$:(PEEK$(PEEKL(p&+4)),11)+PEEK$(PEEKL(p&+8)))
            p&=PEEKL(p&)
        ENDWH
        RETURN
    ENDIF
    opts$(1)="unixpath"
    opts$(2)="unixvar"
    opts$(3)="append"
    opts$(4)="echo"
    opts$(5)="cwdcmd"
    txt$=PEEK$(argv&(2))
    IF txt$="-o"                    Rem set options
        IF n%=2                        Rem no more arguments
            WHILE i%<5
                i%=i%+1
                IF _opts%(i%)
                    txt$="on"
                ELSE
                    txt$="off"
                ENDIF
                fprint%:(PrFmt$:(opts$(i%),11)+txt$)
            ENDWH
        ELSE
            set%=1
Common::
            i%=3
            WHILE i%<=n%
                k%=0
                WHILE k%<5
                    k%=k%+1
                    IF LOWER$(PEEK$(argv&(i%)))=opts$(k%)
                        VECTOR k%
                            Simple,UnixVar,Simple,Simple,Simple
                        ENDV
UnixVar::        IF set%        Rem set variable designated by $ and prompt vars by %
                            _spec$=LEFT$(_spec$,17)+"$%"
                        ELSE            Rem set variable designated by % and prompt vars by $
                            _spec$=LEFT$(_spec$,17)+"%$"
                        ENDIF        Rem fall through to simple to set the variable
Simple::        Rem settings that have no side effects
                        _opts%(k%)=set%
                    ENDIF
                ENDWH
                i%=i%+1
            ENDWH
            _opts$=""
            k%=0
            WHILE k%<5
                k%=k%+1
                IF _opts%(k%)
                    _opts$=_opts$+opts$(k%)+":"
                ENDIF
            ENDWH
            _opts$=LEFT$(_opts$,LEN(_opts$)-1)
        ENDIF
    ELSEIF txt$="+o"        Rem clear options
        IF n%=2                        Rem no more arguments
Rem produce one -o list and one +o list
            WHILE i%<5
                i%=i%+1
                IF _opts%(i%)
                    txt$="-o "
                ELSE
                    txt$="+o "
                ENDIF
                fprint%:("set "+txt$+opts$(i%))
            ENDWH
        ELSE
            set%=0
            GOTO Common::
        ENDIF
    ELSEIF n%=2
ClrVar::
        FreeVar%:(txt$)
    ELSE
        IF PEEK$(argv&(3))="="
            IF n%=3
                GOTO ClrVar::
            ENDIF
            i%=4
        ELSE
            i%=3
        ENDIF
        txt$=PEEK$(argv&(i%))
        WHILE i%<n%
            i%=i%+1
            txt$=txt$+" "+PEEK$(argv&(i%))
        ENDWH
        SetVar%:(PEEK$(argv&(2)),txt$)
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC shift%:(n%)
LOCAL count%,offset%,p&
    ONERR ErrTrap
    IF n%>2
        PRINT "Usage: shift [count]"
        RETURN -2
    ELSE
        IF n%=2
            count%=VAL(PEEK$(argv&(2)))
        ELSE
            count%=1
        ENDIF
        p&=PEEKL(_curr&+PR_BACK%)
        offset%=PEEKB(p&+PR_OFFSET%)
        IF PEEKB(p&)-offset%-count% >= 1
            POKEB(p&+PR_OFFSET%),offset%+count%
        ELSE
            PRINT "shift count must be <= $#"
        ENDIF
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT Err$:(ERR)
    RETURN ERR
ENDP

PROC sysinfo%:(n%)
LOCAL stat$(32),low&,high&
    ONERR ErrTrap::
    stat$="Zero    Very LowLow     Good    "
    fprint%:(MACHINENAME$:)
    fprint%:("Main battery:   "+MID$(stat$,MAINBATTERYSTATUS&:*8+1,8))
    fprint%:("Backup battery: "+MID$(stat$,BACKUPBATTERYSTATUS&:*8+1,8))
    IF ExternalPower&:
        stat$="ON"
    ELSE
        stat$="OFF"
    ENDIF
    fprint%:("Mains power:    "+stat$)
    fprint%:("OS version:     "+NUM$(OsVersionMajor&:,3)+"."+NUM$(OsVersionMinor&:,3)+" (build "+NUM$(OsVersionBuild&:,3)+")")
    fprint%:("ROM version:    "+NUM$(RomVersionMajor&:,3)+"."+NUM$(RomVersionMinor&:,3)+" (build "+NUM$(RomVersionBuild&:,3)+")")
    MACHINEUNIQUEID:(high&,low&)
    fprint%:("Machine ID:     "+HEX$(high&)+"-"+HEX$(low&))
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC unalias%:(n%)
LOCAL p&,q&,i%
    ONERR ErrTrap::
    IF n%<2
        PRINT "Usage: unalias <alias>"
        RETURN -2
    ELSE
        i%=2
        DO
            q&=_atab&
            p&=PEEKL(q&)
            WHILE p&
                IF PEEK$(argv&(i%)) = PEEK$(PEEKL(p&+4))
                    FREEALLOC(PEEKL(p&+4))
Rem                    FREEALLOC&:(PEEKL(p&+4))
                    FREEALLOC(PEEKL(p&+8))
Rem                    FREEALLOC&:(PEEKL(p&+8))
                    POKEL q&,PEEKL(p&)
                    FREEALLOC(p&)
Rem                    FREEALLOC&:(p&)
                    BREAK
                ENDIF
                q&=p&
                p&=PEEKL(p&)
            ENDWH
            IF p&=0
                PRINT PEEK$(argv&(i%)),"- No such alias"
            ENDIF
        i%=i%+1
        UNTIL i%>n%
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC unset%:(n%)
LOCAL i%
    ONERR ErrTrap::
    IF n%<2
        PRINT "Usage: unset <variable>"
        RETURN -2
    ELSE
        i%=2
        DO
            FreeVar%:(PEEK$(argv&(i%)))
            i%=i%+1
        UNTIL i%>n%
    ENDIF
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC ver%:(n%)
    fprint%:("Shell5 v"+_VERSION$+"┬╕ Nick Murray 1998")
ENDP

PROC which%:(n%)
LOCAL buf$(255),i%,p&,com$(255)
    ONERR ErrTrap::
    IF n%<>2
        PRINT "Usage: which <command>"
        RETURN -2
    ENDIF
    com$=PEEK$(argv&(2))
    PRINT com$;":",
    p&=PEEKL(_atab&)
    WHILE p&
        IF com$=PEEK$(PEEKL(p&+4))
            PRINT "aliased to",PEEK$(PEEKL(p&+8))
            RETURN
        ENDIF
        p&=PEEKL(p&)
    ENDWH
    IF com$="goto" OR com$="if" OR com$="time"
        GOTO BuiltIn::
    ENDIF
    WHILE i%<NBUILTIN%
        i%=i%+1
        IF com$=_bltin$(i%)
            GOTO BuiltIn::
        ENDIF
    ENDWH
    com$=_hshf$:(com$)    Rem find/put com$ in the hashed path
    IF LEN(com$)
        PRINT PrPath$:(com$)
    ELSE
        PRINT "Command not found"
    ENDIF
    RETURN
BuiltIn::
    PRINT "Built-in"
    RETURN
ErrTrap::
    ONERR off
    PRINT err$:(ERR)
    RETURN ERR
ENDP

PROC _cpmv%:(n%,mv%)
Rem common copy/move routine. mv%=delete source file
LOCAL dest$(255),i%,ret%,buf$(255)
    ret%=Fparse%:(ADDR(dest$),PEEK$(argv&(n%)))
    IF n%=3
        IF (ret%<0) AND (ret%<>-33)    Rem dest must be valid without wilds
            _Err:(n%,ret%)
            RETURN
        ENDIF
    ELSE
        IF ret%<0
            _Err:(n%,ret%)
            RETURN
        ELSEIF    (ret% AND 16) = 0
            _Err:(n%,2)
            RETURN
        ENDIF
    ENDIF
    i%=2
    WHILE i%<n%
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                BREAK
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        ret%=Fparse%:(ADDR(buf$),PEEK$(argv&(i%)))
        IF ret%<0    Rem any error
            _Err:(i%,ret%)
        ELSEIF ret% AND 16    Rem directory
            _Err:(i%,3)    Rem wanted a file, source is a directory
        ELSE
            IF n%>3
                IF mv%
                    PRINT "Moving",PrPath$:(buf$)
                ELSE
                    PRINT "Copying",PrPath$:(buf$)
                ENDIF
            ENDIF
            TRAP COPY buf$,dest$
            IF ERR
                _Err:(i%,ERR)
            ELSEIF mv%
                TRAP DELETE buf$
                IF ERR=-33    Rem No such file, try d$+"."
                    TRAP DELETE buf$+"."
                ENDIF
                IF ERR
                    _Err:(i%,ERR)
                ENDIF
            ENDIF
        ENDIF
        i%=i%+1
    ENDWH
ENDP

PROC _del%:(p$)
Rem delete the file in p$ (can be a directory)
LOCAL buf$(255),ret%,d$(255),attr%(8)
    ret%=Fparse%:(ADDR(d$),p$)
    IF ret%<0
        PRINT PrPath$:(d$),"-",err$:(ret%)
        RETURN
    ENDIF
    buf$=DIR$(d$)
Start::
    WHILE LEN(buf$)
        IOYIELD
        IF _stat%<>-46
            IF _key%(1)=27
                RETURN
            ELSE
                KEYA(_stat%,_key%())
            ENDIF
        ENDIF
        ret%=xstat%:(buf$)        Rem don't check for error, buf$ is returned by DIR$!
        IF ret% AND 16            Rem directory
            _del%:(buf$)
            IOYIELD                        Rem capture ESC events immediately
            IF _stat%<>-46
                IF _key%(1)=27
                    RETURN
                ELSE
                    KEYA(_stat%,_key%())
                ENDIF
            ENDIF
            buf$=DIR$(d$)
            GOTO Start::
        ELSE
            PRINT "Deleting",PrPath$:(buf$)
            TRAP DELETE buf$
            IF ERR
                PRINT PrPath$:(buf$),"-",err$:(ERR)
            ENDIF
        ENDIF
        buf$=DIR$("")
    ENDWH
    ret%=Fparse%:(ADDR(d$),d$)
    IF ret%>0 AND ((ret% AND 16)=16)
        PRINT "Deleting",PrPath$:(d$)
        TRAP RMDIR d$
        IF ERR
            PRINT PrPath$:(d$),"-",err$:(ERR)
        ENDIF
    ENDIF
ENDP

PROC _gact$:(c%)
Rem print the act that c% represents
LOCAL i%
    IF c%=0
        RETURN "undefined"
    ELSEIF c%<16    Rem one of the internals
        WHILE i%<15
            i%=i%+1
            IF i%=c%
                RETURN _act$(i%)
            ENDIF
        ENDWH
    ELSEIF c%<32
        RETURN "macro"+NUM$(c%-15,2)
    ELSE
        RETURN CHR$(c%)
    ENDIF
ENDP

PROC _kdisp%:(k$,value$,addr&)
LOCAL d$(255)
    d$=PEEK$(addr&)+REPT$(" ",12-LEN(k$))+k$+":"+value$+REPT$(" ",12-LEN(value$))
    IF LEN(d$)+28>ScrInfo%(3)
        fprint%:(d$)
        d$=""
    ELSE
        d$=d$+"  "                    Rem only add inter-entry space if it's not the last entry
    ENDIF
    POKE$ addr&,d$
ENDP

Rem PROC cmdl%:
Rem procedure to toggle display of log window
Rem    _log:((_logid%=0)+2,"")
Rem If logid% is 0, this will be -1 + 2 = 1 = create message window
Rem If logid% is <> 0, this will be 0 + 2 = 2 = remove message window!!
Rem    _extevent%=1        Rem flag something has happened!
Rem ENDP

PROC cmdS1%:
    _extevent%=%1        Rem flag something has happened!
ENDP

PROC cmdS2%:
    _extevent%=%2        Rem flag something has happened!
ENDP

PROC cmdS3%:
    _extevent%=%3        Rem flag something has happened!
ENDP

PROC cmdS4%:
    _extevent%=%4        Rem flag something has happened!
ENDP

PROC _init:
LOCAL t$(206),i%,j%,off%(6),p&,bitmapId1&,bitmapId2&
Rem no error trapping. Any errors here will be (rightly) fatal
Rem set the PATH for temp files, inc. pipes
    PARSE$(cmd$(1),"",off%())
    _syspath$=LEFT$(cmd$(1),off%(4)-1)
Rem CHANGE THIS!!! This is faked so we have a semi-permanent path!!
Rem    _syspath$="c:\System\Apps\Shell5\"
Rem    t$=_syspath$+"buttons.mbm"
Rem    IF EXIST(t$)        Rem if it's not installed DON'T PANIC
Rem        bitmapId1&=gLoadBit(t$,0,0)
Rem        bitmapId2&=gLoadBit(t$,0,1)
Rem    ENDIF
    TBarInit:("Shell 5",ScrWid%,ScrHght%)
Rem    TBarButt:("l",1,"Toggle"+CHR$(10)+"  Log",0,bitmapId1&,bitmapId2&,0)
    i%=1
    WHILE i%<5
        TBarButt:(CHR$(i%+%0),i%,"Button"+CHR$(10)+"    "+CHR$(i%+%0),0,0,0,0)
        i%=i%+1
    ENDWH
    TBarShow:

    _setw%:        Rem set the window size, etc.

Rem    ESCAPE OFF
    LOCK ON    Rem tell the system we don't want events...
    KEYA(_stat%,_key%())            Rem initialize getting ESC
    _spec$=" ""'*?{}<>=+-/#;¦!$%"
Rem space, ", ', *, ?, , {, }, <, >, =. +, -, /, #, ;, ¦, !,$, %
Rem $% Must be last - shell and prompt variable designators resp.
    t$="alias,at,banner,bg,bindkey,cat,cd,chmod,cls,cp,date,df,dirs,echo,edit,exit,hash,help,history,log,ls,mkdir,more,mv,od,pause,popd,pushd,pwd,rename,rescan,rm,rmdir,set,shift,sysinfo,unalias,unset,ver,which,"
    j%=1
    WHILE LEN(t$)
        i%=LOC(t$,",")
        _bltin$(j%)=LEFT$(t$,i%-1)
        t$=RIGHT$(t$,LEN(t$)-i%)
        j%=j%+1
    ENDWH
    t$="delete,delete-right,enter,esc,previous,next,right,left,first,last,start,end,expand,"
    j%=1
    WHILE LEN(t$)
        i%=LOC(t$,",")
        _act$(j%)=LEFT$(t$,i%-1)
        t$=RIGHT$(t$,LEN(t$)-i%)
        j%=j%+1
    ENDWH
    _hnum%=1
    Rem allocate everything at once!!
    _keys&=ALLOC(616+PR_ARGV%)    Rem keys table
    _hpos&=ALLOC(12)        Rem 12 for first entry in alias table
    IF _keys&=0 OR _hpos&=0
        RAISE -10
    ENDIF
    _atab&=_keys&+512            Rem 512 for keys table
    _dirB&=_keys&+524            Rem 12 for first entry in alias table
    _hash&=_keys&+528        Rem 4 for base of the drives
    _vars&=_keys&+532            Rem 4 for base of hash table
    _help&=_keys&+536            Rem 4 for base of variables table
            Rem 4 for base of open help list
            Rem 64 used later for READ-ONLY variables
    _curr&=_keys&+604
    Rem add PR_ARGV%+12=616+PR_ARGV% -  enough space for ARGS +
    Rem pointer + "Shell5" (11 needed)

Rem initialize base argv segment
Rem argc & argn = 1,clear flag and level
    POKEL _curr&,&1000001
    POKEB _curr&+PR_OFFSET%,0    Rem clear offset
Rem set fake first entry for base shell
    POKEL _curr&+PR_ARGV%,_curr&+PR_ARGV%+4
    POKE$ _curr&+PR_ARGV%+4,"Shell5"
Rem initialize the keys table
    i%=256
    WHILE i%
        i%=i%-1
        IF i%<32
            POKEB _keys&+i%,0
        ELSE
            POKEB _keys&+i%,i%
        ENDIF
        POKEB _keys&+i%+256,0
    ENDWH
    POKEW _keys&+8,$D01
            Rem delete & Tab
    POKEB _keys&+264,2            Rem SHIFT delete
    POKEB _keys&+13,3            Rem enter
    POKEB _keys&+27,4            Rem esc
REM big+endian, ie highest byte in highest memory
    POKEL _keys&+391,&6050708        Rem up,down,right & left
    POKEL _keys&+386,&0A090C0B        Rem Pg Up,Pg Dn,Home & end
    POKEB _keys&+363,166                        Rem pipe

    POKEL _hpos&,_hpos&            Rem set next=current
    Rem clear _hpos&+8 and set _hpos&+4
    POKEL _hpos&+4,_hpos&        Rem set prev=current
    POKEL _hpos&+8,0
    POKEL _hash&,0                Rem set current end of hash table
    POKEL _atab&,0                Rem current end of alias table
    POKEL _vars&,0                Rem Delimit vars structure
    POKEL _help&,0                Rem delimit help structure
Rem initialize the READ-ONLY "system" variables
    p&=_keys&+540                Rem part of "big" allocation - 40 bytes
Rem 2 * 12 + LEN("_cwd") + 1 + LEN("_syspath")+1
    POKEL _vars&,p&        Rem link in read-only vars
    POKEL p&,p&+12                Rem second of the two variable blocks
    POKEL p&+4,p&+36        Rem after 3 variable blocks
    POKE$ p&+36,"_shellopts"
    POKEL p&+8,ADDR(_opts$)
    POKEL p&+12,p&+24        Rem new end of variable block
    POKEL p&+16,p&+47        Rem after variable blocks and "_shellopts"
    POKE$ p&+47,"_cwd"
    POKEL p&+20,ADDR(_cwd$)
    POKEL p&+24,0
    POKEL p&+28,p&+52
    POKE$ p&+52,"_syspath"
    POKEL p&+32,ADDR(_syspath$)
Rem initialize the message window
    _log:(1,"")            Rem create log window
    _log:(3,"Initializing...")
    _log:(3,"   Shell5 comes with ABSOLUTELY NO WARRANTY; for details see the file ""COPYING""")
    _log:(3,"   This is free software, and you are welcome to distribute it under certain conditions; for")
    _log:(3,"   details see the file ""COPYING""")
    _nodes:
    SetVar%:("path",_syspath$+"bin")                Rem NOTE we've dropped the .
    SetVar%:("helppath",_syspath$+"help")
    SetVar%:("prompt","%P>")
    SetVar%:("history","10")
    _opts%(varUNIXpath%)=1
    _opts%(varUNIXvar%)=1
    SetVar%:("toolbar","on")
    _log:(3,"Executing autoexec.bat...")
    _chkp%:(_syspath$+"autoexec",0)
    _log:(4,"...completed.")
    _log:(2,"")    Rem close log window
ENDP

PROC _exit:
Rem tidy up - eg. kill help sessions
LOCAL p&
    ONERR ErrTrap::
    p&=PEEKL(_help&)
    WHILE p&
        ONERR ErrCatch::            Rem catch if ENDTASK tries a non-existant thread
        ENDTASK&:(PEEKL(p&+4),0)
ErrCatch::
        ONERR ErrTrap::
        p&=PEEKL(p&)
    ENDWH
ErrTrap::
    STOP
ENDP