blob: 3e5b2933290bdf322bfd93bec636aa43c93368e2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ * IBM Corporation - initial implementation
\ ****************************************************************************/
: words
last @
BEGIN ?dup WHILE
dup cell+ char+ count type space @
REPEAT
;
: .calls ( xt -- )
current-node @ >r 0 set-node \ only search commands, according too IEEE1275
last BEGIN @ ?dup WHILE ( xt currxt )
dup cell+ char+ ( xt currxt name* )
dup dup c@ + 1+ aligned ( xt currxt name* CFA )
dup @ <colon> = IF ( xt currxt name* CFA )
BEGIN
cell+ dup @ ['] semicolon <>
WHILE ( xt currxt *name pos )
dup @ 4 pick = IF ( xt currxt *name pos )
over count type space
BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurrences
THEN
REPEAT
THEN
2drop ( xt currxt )
REPEAT
drop
r> set-node \ restore node
;
0 value #sift-count
false value sift-compl-only
: $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false )
dup cell+ char+ count \ get word name
2dup 6 pick 6 pick find-isubstr \ is there a partly match?
\ in tab completion mode the substring has to be at the beginning
sift-compl-only IF 0= ELSE over < THEN
IF
#sift-count 1+ to #sift-count \ count completions
true
ELSE
2drop false
THEN
;
: $sift ( text-addr text-len -- )
current-node @ >r 0 set-node \ only search commands, according too IEEE1275
sift-compl-only >r false to sift-compl-only \ all substrings, not only compl.
last BEGIN @ ?dup WHILE \ walk the whole dictionary
$inner-sift IF type space THEN
REPEAT
2drop
0 to #sift-count \ we don't need completions here.
r> to sift-compl-only \ restore previous sifting mode
r> set-node \ restore node
;
: sifting ( "text< >" -- )
parse-word $sift
;
|
