!  File  MOUSE:CLI

%begin
%option "-nons-nocheck-nodiag"
%externalroutinespec define logical name(%string(255)name,equiv)
%externalpredicatespec translated logical name(%string(*)%name s)
%externalroutinespec define command symbol(%string(255)sym,equiv)
%externalpredicatespec translated command symbol(%string(*)%name s)
%externalroutinespec readline(%string(*)%name s)
%externalroutinespec runprogram(%string(255)s)
%externalroutinespec phex(%integer x)
%externalroutinespec phex2(%integer x)
%externalroutinespec set terminalmode(%integer mode)
%constinteger noecho=1,notermecho=2,single=4

%ownstring(255)%namearrayname p('1':'8')

%string(255)%fn percent(%integer n)
  %result = p(n) %unless p(n)==nil
  %result = "%".tostring(n)
%end

%routine definepercent(%integer n,%string(255)s)
  dispose(p(n)) %unless p(n)==nil
  p(n) == nil; %returnif s=""
  p(n) == new(p(n)); p(n) = s
%end

%string(255)%fn read interactive line -
  (%string(255)promptstring, initialstring)

! Read a line interactively from the terminal.

! Advanced line editing features include:
!   Command history recall (including line-starting-with "..." matching)
!   Cursor movement left/right
!   Character deletion backwards/forwards
!   Word and line repeat operations for last movement or deletion
!   Character insertion or replacement

! To exploit the advanced editing features, the terminal must be
! of an "approved" type.  Two distinct types are supported, namely
! ANSI-compatible (WY75, VT100/200, Facit) and Visual200-compatible.
! Which of these types of terminal is being used is determined dynamically,
! but instead of using a "who-are-you" enquiry sequence, the type is
! deduced from the first incoming escape sequence.  If the first character
! immediately following the ESC is '[', ANSI mode is assumed.

! Line editing functions are assigned to the following keys:
!   Return:       Accept (the whole of) the current line.
!   North/South:  Recall a line from the history buffer.  The recalled line
!                 must match that part of the current line to the left of
!                 the cursor (this condition is trivially met if the cursor
!                 is already at the beginning of the line).
!   East/West:    Move the cursor around within the current line.
!   DEL:          Erase the character to the left of the cursor.
!   BS:           Erase the character under the cursor, but if the cursor
!                 is at the end of the line, treat it as DEL.
!   HOME:         Repeat the last East/West/BS/DEL until the end of the
!                 line (in the current direction of travel) is reached.
!   LF:           Repeat the last East/West/BS/DEL as far as the next word
!                 boundary (a word is a sequence of alphanumerics).
!   CAN(^X):      Erase the current line completely.
!   ^R:           Re-display the current line.
!   ^A:           Switch between insert and replace mode.
!   EOT(^D):      Return a blank-line-result, which may be used by the
!                 calling code to take special action; normally blank
!                 lines are ignored.

%constinteger maxwidth=131,maxhist=40
%recordformat hf(%record(hf)%name next,last,%string(maxwidth)s)
%ownrecord(hf)%name hput==nil,hget==nil

%constinteger-
  eot=4,
  bs=8,
  tab=9,
  lf=10,
  cr=13,
  esc=27,
  del=127,
  toggle='A'-64,
  refresh='R'-64,
  can='X'-64,
  north='A'+128,
  south='B'+128,
  east='C'+128,
  west='D'+128,
  home='H'+128,
  clearline='K'+128,
  delete='O'+128,
  ansidelete='P'+128,
  ansiinsert='@'+128,
  inserton='i'+128,
  insertoff='j'+128

%owninteger last=0

%constinteger unknown=-1,visual=0,ansi=1
%owninteger terminal=unknown

%constinteger insertmode=1,overwritemode=0
%owninteger mode=insertmode

%bytearray b(0:maxwidth)
%string(maxwidth)%name line
%bytename maxcol
%integer col,sym

%routine setup
! initialise (circular) history buffer.
! this uses a doubly linked list with two pointers:
! HPUT is where the current command is stored,
! HGET is reset to HPUT between commands, and moves backwards
! and forwards through the buffer during editing as the
! North/South keys are used.
%integer i
%record(hf)%namearray h(0:maxhist-1)
  h(i-1) == new(hput) %for i = 1,1,maxhist
  %for i = 0,1,maxhist-1 %cycle
    h(i)_s = ""
    h(i)_last == h(rem(i-1+maxhist,maxhist))
    h(i)_next == h(rem(i+1,maxhist))
  %repeat
  hput == h(0); hget == hput
%end

%routine putsym(%integer sym)
! output ordinary (control or printing) character or escape sequence
  %if sym&128#0 %start
    %returnif terminal=unknown
    %if terminal=ansi %start
      sym = ansidelete %if sym=delete
      sym = ansiinsert %if sym=inserton
      %returnif sym=insertoff
    %finish
    printsymbol(esc)
    printsymbol('[') %if terminal=ansi
  %finish
  printsymbol(sym&127)
%end

%routine newline
  printsymbol(cr);printsymbol(lf)
%End

%integerfn getsym
! input ordinary character or escape sequence and deduce terminal type
%integer sym
  sym = readsymbol&127
  sym = sym!!(cr!!lf) %if sym=cr %or sym=lf
  %result=sym %unless sym=esc
  terminal = visual  { %if terminal=unknown
  sym = readsymbol&127
  terminal = ansi %and sym = readsymbol&127 %if sym='['
  %result = sym!128
%end

%routinespec right

%routine left
  %if col<=0 %start
    col = 0
    right %while col<maxcol
    %return
  %finish
  col = col-1
  putsym(bs)
%end

%routine right
  %if col>=maxcol %start
    col = maxcol
    left %while col>0
    %return
  %finish
  col = col+1
  putsym(east)
%end

%routinespec deleteforward

%routine deletebackward
%integer i
  %if col<=0 %start
    col = 0; %returnif col>=maxcol
    deleteforward; %return
  %finish
  last = del
  putsym(bs)
  %if col=maxcol %start
    putsym(' '); putsym(bs)
  %else
    putsym(delete)
  %finish
  b(i) = b(i+1) %for i = col,1,maxcol-1
  col = col-1; maxcol = maxcol-1
%end

%routine deleteforward
%integer i
  %if col>=maxcol %start
    col = maxcol; %returnif col<=0
    deletebackward; %return
  %finish
  last = bs
  putsym(delete)
  b(i) = b(i+1) %for i = col+1,1,maxcol
  maxcol = maxcol-1
%end

%routine again
  %if last=west %then left %else-
  %if last=east %then right %else-
  %if last=del %then deletebackward %else-
  %if last=bs %then deleteforward
%end

%routine insert(%integer sym)
! deal with ordinary printing character
%integer i
  %if col=maxcol %or mode=overwritemode %start
    %returnif col=maxwidth; col = col+1
    b(col) = sym; putsym(sym)
    maxcol = col %if col>maxcol
  %else
    %returnif maxcol=maxwidth
    b(i+1) = b(i) %for i = maxcol,-1,col+1
    putsym(inserton); putsym(sym); putsym(insertoff)
    col = col+1; maxcol = maxcol+1
    b(col) = sym
  %finish
%end

%predicate alpha(%integer pos)
%integer sym
  %falseif pos<=0
  %falseif pos>maxcol
  sym = b(pos)
  %trueif 'a'<=sym!32<='z'
  %trueif '0'<=sym<='9'
  %false
%end

%routine locate(%integer ns)
! Scan the history buffer in the direction specified by NS (North/South).
! Replace the current line with the first suitable history line we find,
! if any.  "Suitable" means it must start with that part of the current
! line to the left of the cursor (COL).
%integer i
%record(hf)%name pos
%string(maxwidth)match
  match = line; length(match) = col; pos == hget
  %cycle
    %if ns=north %then hget == hget_last %else hget == hget_next
    %returnif pos==hget
    %if length(hget_s)>col %and substring(hget_s,1,col)=match %start
      line = hget_s
      putsym(cr); putsym(clearline); printstring(promptstring)
      printstring(line)
      i = maxcol
      putsym(bs) %and i = i-1 %while i>col
      %return
    %finish
  %repeat
%end

! Main body of READ INTERACTIVE LINE

  maxcol == b(0)
  line == string(addr(b(0)))
  setup %if hput==nil
  set terminalmode(single+noecho+notermecho); prompt("")
  line = initialstring; col = maxcol
  printstring(promptstring); printstring(line)
  %cycle
    sym = getsym
    %if sym=eot %start   {Return null Line}
      newline; line = ""; %exit
    %finish
    %if sym=cr %start    {Return current line if non-empty}
      newline
      %if maxcol#0 %start
        hput_s = line; hput == hput_next; hget == hput; %exit
      %finish
      putsym(cr); printstring(promptstring)
    %elseif sym=north %or sym=south  {History scan up/down}
      locate(sym); last = 0
    %elseif sym=west %or sym=east %or sym=del %or sym=bs   {L/R/DB/DF}
      last = sym; again
    %elseif sym=home   {Repeat to end of line}
      %if last=west %or last=del %start
        again %while col>0
      %elseif last=east %or last=bs
        again %while col<maxcol
      %finish
    %elseif sym=lf %or sym=tab  {Repeat to word boundary}
      %if last=0 %start
        %if sym=tab %then last = east %elsestart
          right %while col<maxcol; last = del
        %finish
      %finish
      again
      %if last=east %or last=west %start
        %cycle
          %exitif col>=maxcol %or col<=0
          again
        %repeatuntil alpha(col+1) %andnot alpha(col)
!     %elseif last=west
!       %cycle
!         %exitif col<=0
!         left
!       %repeatuntil alpha(col+1) %andnot alpha(col)
      %elseif last=bs
        %cycle
          %exitif col>=maxcol %ornot alpha(col+1)
          again
        %repeat
        %cycle
          %exitif col>=maxcol %or alpha(col+1)
          again
        %repeat
      %else {last=del}
        %cycle
          %exitif col<=0 %ornot alpha(col)
          again
        %repeat
        %cycle
          %exitif col<=0 %or alpha(col-1)
          again
        %repeat
      %finish
    %elseif sym=can
      %if terminal=unknown %start
        delete backward %while col>0
      %else
        putsym(cr); putsym(clearline); printstring(promptstring)
        col = 0; maxcol = 0
      %finish
    %elseif sym=refresh
      %if terminal=unknown %then newline %elsestart
        putsym(cr); putsym(clearline)
      %finish
      printstring(promptstring); printstring(line)
      col = maxcol
    %elseif sym=toggle
      mode = mode!!(insertmode!!overwritemode)
    %elseif ' '<=sym<del
      insert(sym)
    %finish
  %repeat
  set terminalmode(-1); prompt(":"); %result = line
%end

%string(255)%fn promptstring
%constinteger cr=13
%string(255)s
  s = "prompt"
  s = "} " %unless translated command symbol(s)
  %result = tostring(cr).s
%end

%string(255)%fn read command
%string(255)line,next
%bytename l == length(line)
  line = read interactive line(promptstring,"")
  set terminal mode(-1)
  prompt("- ")
  %while l[l]='-' %cycle
    l = l-1; readline(next); line = line.next
  %repeat
  %result = line
%end

%routine verify(%string(255)s)
%string(255)v = "verify"
%bytename b == length(v)
  %returnunless translated command symbol(v)
  %returnif b[b]&1=0
  printstring(s); newline
%end

%routinespec obeyfile(%string(255)file,params)

%externalroutine obey command(%string(255)line)
%string(255)verb
%bytename l == length(line), v == length(verb)
%integer lives=9,i,k
again:
  i = 1
  %while i<l %cycle  {replace all occurrences of %1..%8}
    %if l[i]='%' %start
      k = l[i+1]
      %if '1'<=k<='8' %start
        verb = line; v = i-1
        line = substring(line,i+2,l)
        verb = verb.percent(k)
        i = v
        line = verb.line
      %finish
    %finish
    i = i+1
  %repeat
  line = substring(line,2,l) %while l>0 %and l[1]=' ' {strip leading spaces}
  v = 0
  %while v<l %cycle  {separate line into verb and parameter}
    k = l[v+1]
    %exitif k=' ' %or k='=' %or k=',' %or k='/' %or k='-' %or k='?'
    v = v+1; v[v] = k
  %repeat
  v = v-1 %while v[v]=' '
  %return %if v=0     {null verb}
  line = substring(line,v+1,l)
  %if v[1]='!' %start {comment}
    %if v>2 %and v[2]='!' %start
      printstring(substring(verb,2,v);line); newline
    %else
      verify(verb.line)
    %finish
  %elseif k='='       {symbol or logical name (un-)definition}
    verify(verb.line)
    %if l=1 %start    {single = without RHS}
      define command symbol(verb,"")
    %elseif l[2]='='  {double =}
      %if l=2 %start  {without RHS}
        define logical name(verb,"")
      %else           {with RHS}
        line = substring(line,3,l)
        %if line="?" %start
          line = verb
          %if translated logical name(line) %start
            printstring(verb;"==";line); newline
          %finish
        %else
          define logical name(verb,line)
        %finish
      %finish
    %else             {single = with RHS}
      line = substring(line,2,l)
      %if line="?" %start
        line = verb
        %if translated command symbol(line) %start
          printstring(verb;"=";line); newline
        %finish
      %else
        define command symbol(verb,line)
      %finish
    %finish
  %elseif v[1]='@'    {obey file}
    verify(verb.line)
    verb = substring(verb,2,v).".com"
    line = substring(line,2,l) %if l>0 %and l[1]=' '
    obeyfile(verb,line)
  %else
    %if v[v]='_' %start  {suppress symbol translation}
      v = v-1
    %elseif lives>0 %and translated command symbol(verb)
      lives = lives-1
      line = verb.line; ->again
    %finish
    verify(verb.line)
    line = substring(line,2,l) %if l>0 %and l[1]=' '
    cliparam = line
    prompt(":")
    run program(verb)
  %finish
%end

%routine obeyfile(%string(255)file,param)
%string(255)%namearray percent('1':'8')
%string(255)s
%integer i
  %on 9 %start
    closeinput
    %return
  %finish
  percent(i) == nil %for i = '1',1,'8'
  p == percent
  %unless file="" %start
    openinput(0,file)
  %finish
  %if param -> param.("/").s %start
    closeoutput
    openoutput(0,s)
  %finish
  param = param."," %unless param=""
  i = '1'
  %while i<='8' %and param -> s.(",").param %cycle
    define percent(i,s)
    i = i+1
  %repeat
  %cycle
    p == percent
    %if file="" %then s = readcommand %elsestart
      prompt(promptstring)
      %cycle
        i = nextsymbol
        %exitif ' '<i<'{'
        skipsymbol
      %repeat
      readline(s)
    %finish
    obey command(s)
  %repeat
%end

  %on 0,3 %start
    printstring(event_message); newline
  %finish

  closeinput
  %cycle
    obeyfile("","")
  %repeat
%endofprogram