xref: /freebsd/stand/ficl/softwords/marker.fr (revision edf8578117e8844e02c0121147f45e4609b30680)
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;
27