SH
IF{A&(A'=0) 1,
   N("Magic error in: "_A)^#},
"Open / if not open, or not ours.",
IF{O(/)_"."'="P." O(/,"P");
   '/cmdnum O(/,"P")},
"Do initialization if / is new.",
IF{'/cmdnum 1,
   N("If the screen is messed up and you can't see what you're typing, ")^#,
   N("reset terminal (Alt-D) to fix.")^#,
   N("")^#,
   @VERSION,
   @PWD,
   1^/cmdnum,
   0^/dirnum,
   "Current working directory; homedir; root = where SH started from",
   Q(C(%),C($))^/cwd^/home^/root},
O(%,/cwd|0,$,/cwd|1),
1^busy,
DO{busy 1,
   @GETCMD,   
   @PARSE,
   /arg[0]~$U.TO.L^cmd,
   IF{cmd 1+/cmdnum^/cmdnum},
   IF{(cmd="dir")!(cmd="ls") @DIR;
      (cmd="pdir")!(cmd="pls") @PDIR;
      cmd="more" @MORE;
      (cmd="quit")!(cmd="exit") ""^busy;
      cmd="pwd" @PWD;
      cmd="tr" C(/S),IF{'%.MACRO N("No programs here.")^#;$T(0)},O(/U);
      cmd="df" @DF;
      cmd="e" $VIEW(V(/arg[1]));
      cmd="cd" @CD;
      cmd="sethome" /cwd^/home;
      cmd="pushd" @PUSHD;
      cmd="popd" @POPD;
      cmd="dump" @DUMP;
      cmd="g" $G("");
      cmd="job" O(*S,0S),N(*["J"])^#,C(*U);
      cmd="op" @PFX;
      cmd="open" @OPENAPP;
      cmd="fe" $FE(0);
      cmd="vers" @VERSION;
      (cmd="?")!(cmd="help") @HELP;
      cmd="ops" $DIR("*"),%MENU(0,0),O(%,/cwd|0);
      (cmd="hist")!(cmd="history") @HIST;
      cmd="date" S(0)^tmp,N($DATE(tmp)_" "_$TIME(tmp))^#;
      /arg[0]_"."="." 1;
      cmd=cmd @EXEC;
      N("unknown command: "_cmd)^#},
    1},
END;

VERSION
N("PK shell, $Revision: 1.1.2.17 $")^#

HELP
IF{'/H[1] 0^h,
"                            Files & Directories"^/H[h+1^h],
" "^/H[h+1^h],
"df        display list of filesystems (segments)"^/H[h+1^h],
"pwd       print working directory (% as segment:dir)"^/H[h+1^h],
"dir,ls    get list of files in current directory (%)"^/H[h+1^h],
"cd        change current directory (%):"^/H[h+1^h],
"            cd             go home (directory where shell was started)"^/H[h+1^h],
"            cd A:          go to top level of A segment"^/H[h+1^h],
"            cd PK.TEST     go to PK.TEST in current segment"^/H[h+1^h],
"            cd C:PK.TEST   go to PK.TEST in C segment"^/H[h+1^h],
"pushd     push the current directory on the directory stack, and if an"^/H[h+1^h],
"          argument is given, change to that directory"^/H[h+1^h],
"popd      pop the top directory off the stack, and cd there"^/H[h+1^h],
"sethome   set the current directory to be the home directory (used"^/H[h+1^h],
"          as the source for certain commands"^/H[h+1^h],
" "^/H[h+1^h],
" "^/H[h+1^h],
"                            Program Source Files"^/H[h+1^h],
" "^/H[h+1^h],
"pdir,pls  display list of programs/macros (from TR) out of current directory"^/H[h+1^h],
"more      display the contents of a program or macro file"^/H[h+1^h],
"tr        run $T(0)"^/H[h+1^h],
"e         run $VIEW - @Q(e %PK.DAEMON) or @Q(e $TR)"^/H[h+1^h],
" "^/H[h+1^h],
" "^/H[h+1^h],
"                             Prefix Utilities"^/H[h+1^h],
" "^/H[h+1^h],
"op        Shows a list of open prefixes"^/H[h+1^h],
"open      Opens prefixes for a given database. Takes up to three arguments,"^/H[h+1^h],
"          e.g. @Q(open pha pci mis). This uses the most recently compiled PK"^/H[h+1^h],
"          database macros in the current directory (e.g., must be in a PK dir"^/H[h+1^h],
"          with compiled macros to work)."^/H[h+1^h],
"dir       With an argument, dir will show the top level nodes of the"^/H[h+1^h],
"          specified prefix. @Q(dir) is equivalent to @Q(dir %). As a helpful"^/H[h+1^h],
"          shortcut, @Q(dir %foo) will open %foo and show its top level nodes."^/H[h+1^h],
"dump      Dump will dump the contents of a prefix."^/H[h+1^h],
"            dump &          dump all of &"^/H[h+1^h],
"            dump -r &       dump & in reverse order"^/H[h+1^h],
"            dump & GU       dump & starting from GU"^/H[h+1^h],
"            dump -r & GU    dump & in reverse, starting from the end of GU"^/H[h+1^h],
"g         Invoke G for your prefix exploring needs"^/H[h+1^h],
" "^/H[h+1^h],
" "^/H[h+1^h],
"                             Command History"^/H[h+1^h],
" "^/H[h+1^h],
"The shell keeps a (currently unlimited) command history in @Q(/). It may be"^/H[h+1^h],
"displayed with the hist or history command. History may be displayed in"^/H[h+1^h],
"reverse order with the -r flag. History commmands may be replayed with"^/H[h+1^h],
"a limited form of the @Q(!) operator. As in the Bourne shell:"^/H[h+1^h],
" "^/H[h+1^h],
"    !!    repeat last command"^/H[h+1^h],
"    !-5   repeat the command 5 back in the history"^/H[h+1^h],
"    !27   repeat command number 27 in the history"^/H[h+1^h],
" "^/H[h+1^h],
"In addition, the up and down arrow keys may be used to step through"^/H[h+1^h],
"the command history, edit and replay previous commands."^/H[h+1^h],
" "^/H[h+1^h],
" "^/H[h+1^h],
"                              Miscellaneous"^/H[h+1^h],
" "^/H[h+1^h],
"quit,exit exit the shell, return to caller"^/H[h+1^h],
"job       display shell job number"^/H[h+1^h],
"fe        run $FE(0)"^/H[h+1^h],
"ops       enter OPS"^/H[h+1^h],
"date      print current date & time"^/H[h+1^h]},
1^h,
@IP,
DO{running&/H[h] N(/H[h])^l,@P,1+h^h}


Q
"_D(34)_"@1"_D(34)_"

px 0
py 27
pxoff 6
width 80

k.up 21
k.down 4
k.deleol 11
k.return 13
k.tab 9
k.lf 10
k.begin 1

GETCMD
N("")^#,
P(@py,@px,/cmdnum_"> ":6R)L^#,
1^/editing,
""^/viewline,
""^/workingline,
0^/col,
DO{/editing 1,
   P(@py,@pxoff)L^#,
   IF{/viewline 1,
        /hist[/viewline]^#B[@py,@pxoff,/col,@width]^/viewedit,
        IF{/hist[/viewline]'=/viewedit 1,
           /viewedit^/workingline,
           ""^/viewline};
        /workingline^#B[@py,@pxoff,/col,@width]^/workingline},
   #Y^char,
   #Z^/col,
   IF{char=@k.begin 0^/col;
      char=@k.up 1,
         IF{/viewline 1,
            IF{(/viewline>1) 1,
               /viewline-1^/viewline;
               ""^/viewline};
            IF{/cmdnum>1 /cmdnum-1^/viewline}},
         IF{/viewline L(/hist[/viewline])^/col};
      char=@k.down 1,
         IF{/viewline 1,
            IF{/viewline<(/cmdnum-1) 1,
               /viewline+1^/viewline;
               ""^/viewline};
            IF{/cmdnum>1 1^/viewline}},
         IF{/viewline L(/hist[/viewline])^/col};
      char=@k.return 1,
         IF{/viewline /viewedit^/workingline},
         ""^/editing;
      (char=@k.lf)!(char=@k.tab) 1,
         IF{'/viewline 1,
            @SUBST,
            L(/workingline)^/col};
      char=@k.deleol 1,
         IF{/viewline /viewedit^/workingline,""^/viewline},
         /workingline$/col^/workingline}},
@SUBST,
/workingline^/cmd,
/cmd^/hist[/cmdnum]

; Current:
; !!
; !-1
; !-2
; !13
; To do:
; !$
; !!:1
; !13:1
; !-2:1
; !more
SUBST
IF{/workingline$1="!" 1,
   /workingline%0^/workingline,
   IF{/workingline$1="-" /cmdnum-(/workingline%0)^/tmp;
      /workingline$1="!" /cmdnum-1^/tmp;
      /workingline^/tmp},
   /hist[/tmp]^/workingline},
""^/macsetup,
0^lastat,
DO{(L(/workingline'$lastat,D(64))+lastat^x)'=L(/workingline) 1,
   x+1^lastat,
   /workingline$x^/left,
   /workingline%x^/right,
   L(/right)^len,
   0^y,
   DO{(y<len)&((/right#y)'<"a")&((/right#y)'>"z") 1+y^y},
   IF{y>0 1,
      /right$y^/mac,
      /right'$y^/right,
      IF{'/macsetup 1^/macsetup,
         O(%,/home|0,$,/home|1),
         O(*S,%.MACRO),
         O(!S,*TABLE),
         C(*U)},
      !L[/mac]^/exp,
      IF{/exp 1,
         /left_/exp_/right^/workingline}}},
IF{/macsetup 1,
   C(!U),
   O(%,/cwd|0,$,/cwd|1)}

PARSE
K(/arg),
0^i,
0^nr,
"0 "^is,
DO{/cmd#is^/arg 1,
   (/arg):0X:0S^/arg[nr],
   i+1^i,
   i_" "^is,
   nr+1^nr}

EXEC
"Point Xerror at ourselves for executing command-line Magic.",
O($S,$),
O(%S,%),
O(%,/root|0,$,/root|1),
X(%SH),
C($U),
C(%U),
"Grab the Magic, protect our private space.",
/cmd^cmd,
"C(/S)",
"Execute.",
N(V(cmd):0X)^#,
"Restore state.",
"O(/U)",
X("")

OPENAPP
O(%,/home|0,$,/home|1),
"&*\:?"^/prefixes,
1^/valid["data"]^/valid["indx"]^/valid["dict"]^/valid["rpt"],
0^/pi,
O(*S,%.MACRO),
O(!S,*TABLE),
C(*U),
@DOOPENAPP(/arg[1]),
@DOOPENAPP(/arg[2]),
@DOOPENAPP(/arg[3]),
C(!U),
O(%,/cwd|0,$,/cwd|1)

DOOPENAPP
@1^/app,
IF{/app !L[/app_"dir"]^/dircmd,
   IF{/dircmd 1,
      IF{/dircmd$4="$SEG" 1,
         @OPENIT;
         N(/app_" is not configured here")^#};
      N("unknown db set: "_/app)^#,
      1},
   1}

OPENIT
V(/dircmd),
/app^/lp,
DO{(+!L[/lp]^/lp)&(/lp$L(/app)=/app)&(/pi<L(/prefixes)) 1,
   IF{/valid[/lp'$L(/app)] 1,
      @REALLYOPEN(/prefixes#/pi,/lp),
      /pi+1^/pi}},
O(%,/home|0,$,/home|1)

REALLYOPEN
@1^/pfx,
@2^/what,
N("open "_/what_" ("_!L[/what]_") on "_/pfx)^#,
"O("_/pfx_","_!L[/what]_")"^/opstr,
IF{V(/opstr) " ok"^#; " failed"^#}

HIST
@IP,
""^tmp,
DO{running&(IF{/arg[1]="-r" </hist[tmp]^tmp;>/hist[tmp]^tmp}) 1,
   tmp_": "_/hist[tmp]^l,
   @P}

PFX
"%#$&*\?:/!"^tmp,
DO{IF{V("O("_(tmp$1)_")")^tmp1 N(" ":5,tmp$1,"=",tmp1)^#},tmp%0^tmp}

CD
IF{'/arg[1] O(%,/home|0,$,/home|1);
   /arg[1]~$L.TO.U^/arg[1],
   /arg[1]#"0:"^tmp,
   /arg[1]#"1:"^tmp2,
   IF{L(/arg[1],":")'=L(/arg[1]);
      tmp^tmp2,
      "*"^tmp},
   IF{'tmp2 1,
      $SEG(tmp,"*"),
      O(%,$.LIMBS);
      $SEG(tmp,tmp2)},
   1},
@PWD,
Q(C(%),C($))^/cwd,
O(%,/cwd|0,$,/cwd|1)

PUSHD
1+/dirnum^/dirnum,
/cwd^/dirstack[/dirnum],
IF{/arg[1]&(/arg[1]'=".") @CD;
   @PWD}

POPD
IF{0=/dirnum N("Directory stack empty.")^#;
   /dirstack[/dirnum]^/cwd,
   /dirnum-1^/dirnum,
   O(%,/cwd|0,$,/cwd|1)},
@PWD

PWD
$DIR.NAME(%)^tmp,
N($MAC_":"_tmp|0)^#

DF
""^tmp,
DO{+$MAC[tmp]^tmp 1,
   tmp^l,
   @P}

PDIR
@IP,
IF{O(*S,%.MACRO) 1,
   ""^tmp,
   DO{running&(>*M[tmp]^tmp) "M "_tmp^l,@P},
   ""^tmp,
   DO{running&(>*S[tmp]^tmp) "P "_tmp^l,@P},
   C(*U)}

MORE
@IP,
O(*S,%.MACRO),
O(:S,*M[/arg[1]])^op,
IF{'op O(:S,*S[/arg[1]])^op},
IF{'op 1,
   N("program "_/arg[1]_" not found")^#;
   1^running,
   DO{(+:)&(running) 1,
      :^l,
      @P},
   C(:U)},
C(*U)

QO
D(34)_@1_D(34)

; argument number counter
argnum   /DUMP[.argnum]

; direction of dump (< or >)
dir      /DUMP[.dir]

; dumping a single node/object?
single   /DUMP[.single]

; option parsing for -rs
opt      /DUMP[.opt]

; prefix we're dumping ($, &, *...)
pfx      /DUMP[.pfx]

; node we're dumping (GU, GUIX, ...)
node     /DUMP[.node]

; object of node we're dumping (PTKEEPER...)
obj      /DUMP[.obj]

; index we're iterating over, may or may not start out nil
indx     /DUMP[.indx]

; identifier of what we're indexing over, if -s
id       /DUMP[.id]

; our basic query
qry      /DUMP[.qry]

; This code is kind of messed up, but mostly works right.
; It needs to be rewritten with a full understanding of identifiers.
DUMP
@IP,
1^@argnum,
">"^@dir,
""^@single,
IF{/arg[@argnum]#0="-" 1,
   0^@opt,
   DO{@opt+1<L(/arg[@argnum]) @opt+1^@opt,
      IF{/arg[@argnum]#@opt="r" "<"^@dir;
         /arg[@argnum]#@opt="s" 1^@single}},
   @argnum+1^@argnum},
/arg[@argnum]^@pfx,
/arg[@argnum+1]^@node,
/arg[@argnum+2]^@obj,
IF{'@single 1,
   IF{@obj @obj^@indx,""^@obj;
      IF{@node @node^@indx,""^@node}};
   ""^@indx},
""^@id,
IF{@node @QO(@node)^@id},
IF{@obj @id_","_@QO(@obj)^@id},
; @id looks like "GU" or "GU","PTKEEPER"
IF{@id 1,
   "["_@id_",@indx]"^@qry;
   "[@indx]"^@qry},
; @qry looks like ["GU","PTKEEPER",@indx]
DO{running 1,
   IF{@indx!@id 1,
      @pfx_"["_@id^l,
      IF{@id ","^b;""^b},
      0^i,
      DO{i_"S"^x,@indx#x^y 1,
         l_b_y^l,
         ","^b,
         i+1^i},
      IF{@indx 1,
         l_"] = "_V(@pfx_@qry)^l;
         l_"] = "_V(@pfx_"["_@id_"]")^l},
      @P},
   V(@dir_@pfx_@qry_"^@indx"),
   IF{'@indx ""^running}},
K(/DUMP)

DIR
@IP,
""^idx,
""^pop,
9^type,
IF{L(/arg[1])=0 "%"^/arg[1]},
IF{L(/arg[1])>1 1,
   V("O(!S,"_/arg[1]_")")^type,
   1^pop,
   "!"^/arg[1]},
IF{(type=9)!(type=1) 1,
   DO{running&V("+"_/arg[1]_"[idx]^idx") 1,
      idx#0S^l,
      @P};
   type=0 1,
      DO{(+!)&(running) 1,
      !^l,
      @P}},
IF{pop 1,
   C(!U)}

LOG
@1^x,
N("log "_x)^#

IP
0^li,
22^page,
1^running

P
""^lf,
""^q,
IF{li'<page 1,
   1^lf,
   N("-- more --")^#,
   #S^q,
   D(13)_"          "_D(13)^#,
   IF{q=D(13) 1,
      page-1^li;
      0^li}},
li+(L(l)/@width)+1^li,
IF{(q="q")!(q="Q")!(q=D(27)) 1,
   ""^running;
   IF{'lf 1,
      N(l:0X)^#;
      l:0X^#}}
