home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / XEXPECT.SEQ < prev   
Encoding:
Text File  |  1989-07-11  |  3.9 KB  |  126 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 xbseg      \ extended expect buffer segment
  25.   0    value save-get1? \ first time we press down arrow this is 0.
  26.  
  27. create xtmp cmdlen allot
  28. 0 value xbuf#
  29.  
  30. : xbinit        ( --- )
  31.                 xbseg if exit then      \ leave if done already
  32.                 cmdlen xmax 1+          \ saved lines
  33.                 * paragraph alloc 8 =     \ allocate the segments
  34.                 if      cr ." Couldn't allocate command line save buffer."
  35.                 then    nip =: xbseg
  36.                 xbseg 0 cmdlen xmax 1+ * 0 LFILL ;
  37.  
  38. xbinit          \ Allocate some space so we can use line edit now.
  39.  
  40. headers
  41.  
  42. : xbuf_init     ( --- )
  43.                 defers initstuff
  44.                 off> xbseg
  45.                 xbinit ;
  46.  
  47. ' xbuf_init is initstuff
  48.  
  49. headerless
  50.  
  51. : xbuf#-        ( --- )
  52.                 xbuf# 1- 0<
  53.                 if      xmax =: xbuf#
  54.                 else    decr> xbuf#
  55.                 then    ;
  56.  
  57. : xbuf#+        ( --- )
  58.                 xbuf# 1+ xmax u>
  59.                 if      off> xbuf#
  60.                 else    incr> xbuf#
  61.                 then    ;
  62.  
  63. : >xbuf         ( --- a1 )
  64.                 xbuf# xmax min 0MAX cmdlen * ;
  65.  
  66. : save-get      ( a1 --- )      \ a1 = CFA of buf inc or dec word
  67.                 >r
  68.                 editbuf c@
  69.                 if      ?cs: editbuf dup>r xbseg >xbuf r> c@ 1+ cmovel
  70.                 then    r> execute
  71.                 xbseg >xbuf 2dup c@l >r ?cs: editbuf r> 1+ cmovel
  72.                 off> ecursor .eline
  73.                 on> autoclear
  74.                 on> save-get1? ;
  75.  
  76. : xup           ( --- )
  77.                 ['] xbuf#- save-get ;
  78.  
  79. : xdown         ( --- )
  80.                 save-get1?
  81.                 if      ['] xbuf#+
  82.                 else    ['] noop
  83.                 then    save-get ;
  84.  
  85. headers
  86.  
  87. : xexpect       ( a1 n1 --- )
  88.                 xbseg printing @ 0= and         \ use old expect if printing
  89.         if      off> save-get1?
  90.                 ['] xup     save!> doup
  91.                 ['] xdown   save!> dodown
  92.                 ['] defmenu save!> equit
  93.                 ['] >norm   save!> >edattrib
  94.                             save>  keysfuncptr
  95.                 >keys1
  96.                 xbuf#+
  97.                 xtmp off
  98.                 on> autoclear           \ clear line if first char is letter
  99.                 off> stripping_bl's     \ don't strip trailing spaces
  100.                 swap >r >r              \ save destination address under
  101.                 off> ecursor
  102.                 insertmode off
  103.                 #out @ #line @ xtmp r> <ledit> drop
  104.                 r>                      \ recover destination address
  105.                 doend .ecursor
  106.                 xtmp c@
  107.                 if      ?cs: xtmp dup>r xbseg >xbuf r> c@ 1+ cmovel
  108.                 then    ( a1 --- )      \ a1 is the address passed to EXPECT.
  109.                 xtmp count >r swap r@ cmove   \ move the line to TIB
  110.                 R> span ! space
  111.                 restore> keysfuncptr
  112.                 restore> >edattrib
  113.                 restore> equit
  114.                 restore> dodown
  115.                 restore> doup
  116.         else    (expect)
  117.         then    ;
  118.  
  119. ' xexpect is expect
  120.  
  121. behead
  122.  
  123. only forth also definitions
  124.  
  125.  
  126.