stand/ficl/softwords/marker.fr

   1 \ ** ficl/softwords/marker.fr
   2 \ ** Ficl implementation of CORE EXT MARKER
   3 \ John Sadler, 4 Oct 98
   4 \ Requires ficl 2.02 FORGET-WID !!
   5 \
   6
   7 : marker   ( "name" -- )
   8     create
   9     get-current ,
  10     get-order dup ,
  11     0 ?do , loop
  12   does>
  13     0 set-order                     \ clear search order
  14     dup body> >name drop
  15     here - allot                    \ reset HERE to my xt-addr
  16     dup @                           ( pfa current-wid )
  17     dup set-current forget-wid      ( pfa )
  18     cell+ dup @ swap                ( count count-addr )
  19     over cells + swap               ( last-wid-addr count )
  20     0 ?do
  21         dup @ dup                   ( wid-addr wid wid )
  22         >search forget-wid          ( wid-addr )
  23         cell-
  24     loop
  25     drop
  26 ;