home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / xexpect.seq < prev    next >
Text File  |  1991-02-05  |  4KB  |  122 lines
  1. \ XEXPECT.SEQ   A version of EXPECT that allows line editing  by Tom Zimmer
  2.  
  3. comment:
  4.  
  5.         This little utility allows you to use the line editors control
  6.         key sequences to edit the Forth command line.  If you make an
  7.         error while typing, you can recover the previously entered line
  8.         by pressing ESC. Terminate the entry with the <Enter> key.
  9.  
  10.         You can also recover previously entered Forth command lines up
  11.         to 4, by pressing Up or Down arrow to step through the command
  12.         line list.
  13.  
  14.         This utility adds about 1k to the system.
  15.  
  16. comment;
  17.  
  18. only forth also hidden also definitions
  19.  
  20. headerless
  21.  
  22.  12 constant xmax       \ number of command lines to stack.
  23. 133 constant cmdlen     \ length of one command line.
  24.   0    value save-get1? \ first time we press down arrow this is 0.
  25.  
  26. cmdlen xmax 1+ * s>d pointer xbseg      \ extended expect buffer segment
  27.  
  28. create xtmp cmdlen allot
  29. 0 value xbuf#
  30.  
  31. : xbinit        ( --- )
  32.                 xbseg 0= abort" Couldn't allocate command line save buffer."
  33.                 xbseg 0 cmdlen xmax 1+ * 0 LFILL ;
  34.  
  35. xbinit          \ Allocate some space so we can use line edit now.
  36.  
  37. headers
  38.  
  39. : xbuf_init     ( --- )
  40.                 defers initstuff
  41.                 xbinit ;
  42.  
  43. ' xbuf_init is initstuff
  44.  
  45. headerless
  46.  
  47. : xbuf#-        ( --- )
  48.                 xbuf# 1- 0<
  49.                 if      xmax =: xbuf#
  50.                 else    decr> xbuf#
  51.                 then    ;
  52.  
  53. : xbuf#+        ( --- )
  54.                 xbuf# 1+ xmax u>
  55.                 if      off> xbuf#
  56.                 else    incr> xbuf#
  57.                 then    ;
  58.  
  59. : >xbuf         ( --- a1 )
  60.                 xbuf# xmax min 0MAX cmdlen * ;
  61.  
  62. : save-get      ( a1 --- )      \ a1 = CFA of buf inc or dec word
  63.                 >r
  64.                 editbuf c@
  65.                 if      ?cs: editbuf dup>r xbseg >xbuf r> c@ 1+ cmovel
  66.                 then    r> execute
  67.                 xbseg >xbuf 2dup c@l >r ?cs: editbuf r> 1+ cmovel
  68.                 off> ecursor .eline
  69.                 on> autoclear
  70.                 on> save-get1? ;
  71.  
  72. : xup           ( --- )
  73.                 ['] xbuf#- save-get ;
  74.  
  75. : xdown         ( --- )
  76.                 save-get1?
  77.                 if      ['] xbuf#+
  78.                 else    ['] noop
  79.                 then    save-get ;
  80.  
  81. headers
  82.  
  83. : xexpect       ( a1 n1 --- )
  84.                 xbseg printing @ 0= and         \ use old expect if printing
  85.         if      off> save-get1?
  86.                 ['] xup     save!> doup
  87.                 ['] xdown   save!> dodown
  88.                 ['] defmenu save!> equit
  89.                 ['] >norm   save!> >edattrib
  90.                             save>  keysfuncptr
  91.                 >keys1
  92.                 xbuf#+
  93.                 xtmp off
  94.                 on> autoclear           \ clear line if first char is letter
  95.                 off> stripping_bl's     \ don't strip trailing spaces
  96.                 swap >r >r              \ save destination address under
  97.                 off> ecursor
  98.                 insertmode off
  99.                 #out @ #line @ xtmp r> <ledit> drop
  100.                 r>                      \ recover destination address
  101.                 doend .ecursor
  102.                 xtmp c@
  103.                 if      ?cs: xtmp dup>r xbseg >xbuf r> c@ 1+ cmovel
  104.                 then    ( a1 --- )      \ a1 is the address passed to EXPECT.
  105.                 xtmp count >r swap r@ cmove   \ move the line to TIB
  106.                 R> span ! space
  107.                 restore> keysfuncptr
  108.                 restore> >edattrib
  109.                 restore> equit
  110.                 restore> dodown
  111.                 restore> doup
  112.         else    (expect)
  113.         then    ;
  114.  
  115. ' xexpect is expect
  116.  
  117. behead
  118.  
  119. only forth also definitions
  120.  
  121.  
  122.