1 \ *****************************************************************************
2 \ * Copyright (c) 2004, 2008 IBM Corporation
3 \ * All rights reserved.
4 \ * This program and the accompanying materials
5 \ * are made available under the terms of the BSD License
6 \ * which accompanies this distribution, and is available at
7 \ * http://www.opensource.org/licenses/bsd-license.php
10 \ * IBM Corporation - initial implementation
11 \ ****************************************************************************/
16 dup cell+ char+ count type space @
21 current-node @ >r 0 set-node \ only search commands, according too IEEE1275
23 last BEGIN @ ?dup WHILE ( xt currxt )
24 dup cell+ char+ ( xt currxt name* )
25 dup dup c@ + 1+ aligned ( xt currxt name* CFA )
26 dup @ <colon> = IF ( xt currxt name* CFA )
28 cell+ dup @ ['] semicolon <>
29 WHILE ( xt currxt *name pos )
30 dup @ 4 pick = IF ( xt currxt *name pos )
32 BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurrences
40 r> set-node \ restore node
44 false value sift-compl-only
46 : $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false )
47 dup cell+ char+ count \ get word name
48 2dup 6 pick 6 pick find-isubstr \ is there a partly match?
49 \ in tab completion mode the substring has to be at the beginning
50 sift-compl-only IF 0= ELSE over < THEN
52 #sift-count 1+ to #sift-count \ count completions
59 : $sift ( text-addr text-len -- )
60 current-node @ >r 0 set-node \ only search commands, according too IEEE1275
61 sift-compl-only >r false to sift-compl-only \ all substrings, not only compl.
62 last BEGIN @ ?dup WHILE \ walk the whole dictionary
63 $inner-sift IF type space THEN
66 0 to #sift-count \ we don't need completions here.
67 r> to sift-compl-only \ restore previous sifting mode
68 r> set-node \ restore node
71 : sifting ( "text< >" -- )