marker.fr revision 40843
140843Smsmith\ ** ficl/softwords/marker.fr
240843Smsmith\ ** Ficl implementation of CORE EXT MARKER
340843Smsmith\ John Sadler, 4 Oct 98
440843Smsmith\ Requires ficl 2.02 FORGET-WID !!
540843Smsmith
640843Smsmith: marker   ( "name" -- )
740843Smsmith    create  
840843Smsmith    get-current ,
940843Smsmith    get-order dup , 
1040843Smsmith    0 ?do , loop 
1140843Smsmith  does>
1240843Smsmith    0 set-order                     \ clear search order
1340843Smsmith    dup body> >name drop 
1440843Smsmith    here - allot                    \ reset HERE to my xt-addr
1540843Smsmith    dup @                           ( pfa current-wid )
1640843Smsmith    dup set-current forget-wid      ( pfa )
1740843Smsmith    cell+ dup @ swap                ( count count-addr )
1840843Smsmith    over cells + swap               ( last-wid-addr count )
1940843Smsmith    0 ?do 
2040843Smsmith        dup @ dup                   ( wid-addr wid wid )
2140843Smsmith        >search forget-wid          ( wid-addr )
2240843Smsmith        cell- 
2340843Smsmith    loop
2440843Smsmith    drop
2540843Smsmith;
26