File:  [gforth] / gforth / blocked.fb
Revision 1.4: download - view: text, annotated - select for diffs
Sat Nov 6 22:43:14 1999 UTC (17 years, 11 months ago) by pazsan
Branches: MAIN
CVS tags: v0-7-0, v0-6-2, v0-6-1, v0-6-0, v0-5-0, HEAD
Added "Forth definitions" at the end

\\ some comments on this simple editor                 29aug95pym marks current position        a goes to marked position       c moves cursor by n chars       t goes to line n and inserts    i inserts                       d deletes marked area           r replaces marked area          f search and mark               il insert a line                dl delete a line                qx gives a quick index          nx gives next index             bx gives previous index                                         n goes to next screen           b goes to previous screen       l goes to screen n              v goes to current screen        s searches until screen n       y yank deleted string                                                                           Syntax and implementation style a la PolyFORTH                  If you don't like it, write a block editor mode for Emacs!                                                                                                                                      \ display block                                        29aug95pyVocabulary editor                                               Variable r#                     Variable len                    2Variable mark                  Create rbuf  $100 allot         Create ibuf  $100 allot         Create fbuf  $100 allot         : rvson $1B emit ." [7m" ;      : rvsoff $1B emit ." [0m" ;     : hi r# @ c/l /mod 1+ swap 3 + swap at-xy                         rvson scr @ block r# @ + len @ type rvsoff 0 &17 at-xy ;      : l editor page list hi ;       : v  scr @ l ;                  : delete  ( buffer size count -- )                                over min >r  r@ - ( left over )  dup 0>                         IF  2dup swap dup  r@ +  -rot swap move  THEN  + r> blank ;   : insert  ( string length buffer size -- )                        rot over min >r  r@ -  over dup r@ +  rot move  r> move ;     : replace   ( string length buffer size -- ) rot min move ;     editor definitions                              -->             \ in screen command                                    29aug95py: m  scr @ r# @ mark 2! ;                                       : a  mark 2@ m r# ! l ;                                         : c  r# +! 1 len ! v ;                                          : 'rest ( -- a u )  scr @ block chars/block  r# @ /string ;     : 'line ( -- a u )  'rest  1- c/l 1- and 1+ ;                   : 'par  ( buf -- a u )  >r 0 parse dup                             0= IF 2drop r> count  ELSE  2dup  r> place  THEN ;           : t  c/l * r# ! c/l len !                                         0 parse tuck 'line insert IF update THEN v ;                  : i  ibuf 'par 'line insert update v ;                          : d  'line 2dup rbuf place len @  delete update v ;             : r  d i ;                                                      : y  rbuf count 'line insert update v ;                         : f  'rest  len @ c/l mod /string fbuf 'par dup len ! search      0= throw nip chars/block swap - r# ! v ;      -->             \ multi screen commands                                29aug95py: il  pad c/l 'rest insert 'rest drop c/l blank update v ;      : dl  'rest c/l  delete  update v ;                             : qx ( -- )  0 0 at-xy scr @ &60 / &60 * &60 bounds               DO  3 0  DO  [ FORTH ] i 1+ [ EDITOR ] j + dup 3 .r                          space  dup scr @ = IF rvson  THEN                               block &20 type  rvsoff  LOOP  cr  3 +LOOP ;      : nx  &60 scr @ +       scr !  qx ;                             : bx -&60 scr @ + 0 max scr !  qx ;                             : n  scr @ 1+ l r# off ;                                        : b  scr @ 1- l r# off ;                                        : s ( n -- / n )   >r                                             BEGIN  ['] f catch  WHILE  scr @ r@ =  IF  rdrop  EXIT  THEN           scr @ r@ u<  IF  n  ELSE  b  THEN  REPEAT  r> ;        Forth definitions                                                                                                               

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>