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