\ *** Block No. 0 Hexblock 0 
\ Commandline EDitor for volksFORTH rev. 3.80        cas 10nov05
This File contains definitions to create an editable Forth      
command line with history.                                      
The commandline histroy allows older commands to be recalled.   
These older commands will be stored in Screen 0 in a file called
"history" and will be preserved even when calling SAVE-SYSTEM.  
                                                                
                                                                
Keys:                                                           
  Cursor left/right                                           
  Delete Char                             <del> und <-          
  Delete Line                             <esc>                 
  toggle Insert                           <ins>                 
  finish line                             <enter>               
  Jump to Beginning/End of Line           <pos1> <end>          
  recall older commands                                       
\ *** Block No. 1 Hexblock 1 
\ Commandline EDitor LOAD-Screen                     cas 10nov05
                                                                
                                                                
: curleft ( -- )  at? 1- at ;                                   
: currite ( -- )  at? 1+ at ;                                   
                                                                
1 5 +thru  \ enhanced Input                                     
                                                                
.( Commandline Editor loaded ) cr                               
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
\ *** Block No. 2 Hexblock 2 
\ History -- Commandhistory                          cas 10nov05
makefile history  1 more                                        
                                                                
| Variable line#       line# off                                
| Variable lastline#   lastline# off                            
                                                                
| : 'history ( n -- addr )  isfile push  history                
    c/l *   b/blk /mod  block + ;                               
                                                                
| : @line ( n -- addr len )  'history c/l -trailing ;           
| : !history ( addr line# -- )                                  
      'history dup c/l blank  span @ c/l min cmove update ;     
| : @history ( addr line# -- )                                  
      @line rot swap dup span ! cmove ;                         
                                                                
| : +line ( n addr -- )  dup @  rot + l/s  mod  swap ! ;        
\ *** Block No. 3 Hexblock 3 
\ End of input                                       cas 10nov05
                                                                
| Variable maxchars               | Variable insert insert on   
                                                                
| : -text ( a1 a2 l -- 0=equal )  bounds                        
      ?DO count I c@ - ?dup IF nip ENDLOOP exit THEN LOOP 0= ;  
                                                                
| : done ( a p1 -- a p2 )  2dup                                 
      at?  rot -  span @ dup maxchars !  + at space blankline   
      line# @ @line  span @ = IF span @ -text 0=exit 2dup THEN  
      drop  lastline# @ !history  1 lastline# +line ;           
                                                                
                                                                
                                                                
                                                                
                                                                
\ *** Block No. 4 Hexblock 4 
\ enhanced input                                     cas 10nov05
| : redisplay ( addr pos -- )                                   
     at?  2swap  span @ swap /string type blankline at ;        
                                                                
| : del   ( addr pos -- )  span @ 0=exit  dup >r   + dup 1+ swap
      span @ r> - cmove   -1 span +! ;                          
| : ins   ( addr pos1 -- )  dup >r   + dup  dup 1+              
      span @ r> - cmove>   bl swap c!  1 span +! ;              
                                                                
| : delete  ( a p1 -- a p2 )  2dup del  2dup redisplay ;        
| : back ( a p1 -- a p2 )  1- curleft delete ;                  
                                                                
| : recall ( a p1 -- a p2 ) at? rot - at  dup line# @ @history  
     dup 0 redisplay  at? span @ + at  span @ ;                 
                                                                
| : <start ( a1 p1 -- a2  p2 )  at?  rot - at  0 ;              
\ *** Block No. 5 Hexblock 5 
\ Keyassignment for Commandline-Editor MS-DOS        cas 10nov05
                                                                
: (decode ( addr pos1 key -- addr pos2 )                        
  -&77  case? IF dup  span @ < 0=exit  currite 1+   exit THEN   
  -&75  case? IF dup           0=exit  curleft 1-   exit THEN   
  -&82  case? IF insert @ 0=   insert !             exit THEN   
   #bs  case? IF dup           0=exit  back         exit THEN   
  -&83  case? IF span @ 2dup < and 0=exit delete    exit THEN   
  -&72  case? IF -1 line# +line recall              exit THEN   
  -&80  case? IF  1 line# +line recall              exit THEN   
   #cr  case? IF done                               exit THEN   
   #esc case? IF <start span off  2dup redisplay    exit THEN   
  -&71  case? IF <start                             exit THEN   
  -&79  case? IF at? rot -  span @ +  at  span @    exit THEN   
   dup emit >r  insert @ IF 2dup ins THEN   2dup +              
   r>  swap c!  1+  dup span @ max span ! 2dup redisplay ;      
\ *** Block No. 6 Hexblock 6 
\ Patch                                              cas 10nov05
                                                                
: showcur ( -- )                                                
   insert @ IF &11 ELSE &6 THEN &12 curshape ;                  
                                                                
: (expect ( addr len -- )  maxchars !   span off                
    lastline# @ line# !  0                                      
    BEGIN span @ maxchars @ u<                                  
    WHILE key decode showcur REPEAT 2drop ;                     
                                                                
' (decode ' keyboard 6 + !                                      
' (expect ' keyboard 8 + !                                      
                                                                
                                                                
                                                                
                                                                
\ *** Block No. 7 Hexblock 7 
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
                                                                
