Better presentation for ambiguous-use-error, fix ui.tools.listener now that 'search' can throw, make USE: and UNUSE: ignore dupes
parent
93509cdcec
commit
90560d3959
|
@ -251,8 +251,15 @@ M: already-disposed summary drop "Attempting to operate on disposed object" ;
|
||||||
M: no-current-vocab summary
|
M: no-current-vocab summary
|
||||||
drop "Not in a vocabulary; IN: form required" ;
|
drop "Not in a vocabulary; IN: form required" ;
|
||||||
|
|
||||||
M: no-word-error error.
|
M: no-word-error summary
|
||||||
"No word named ``" write name>> write "'' found in current vocabulary search path" print ;
|
name>> "No word named ``" "'' found in current vocabulary search path" surround ;
|
||||||
|
|
||||||
|
M: no-word-error error. summary print ;
|
||||||
|
|
||||||
|
M: ambiguous-use-error summary
|
||||||
|
words>> first name>> "More than one vocabulary defines a word named ``" "''" surround ;
|
||||||
|
|
||||||
|
M: ambiguous-use-error error. summary print ;
|
||||||
|
|
||||||
M: staging-violation summary
|
M: staging-violation summary
|
||||||
drop
|
drop
|
||||||
|
|
|
@ -55,7 +55,9 @@ M: vocab-completion (word-at-caret)
|
||||||
drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
|
drop dup vocab-exists? [ >vocab-link ] [ drop f ] if ;
|
||||||
|
|
||||||
M: word-completion (word-at-caret)
|
M: word-completion (word-at-caret)
|
||||||
manifest>> dup [ search-manifest ] [ 2drop f ] if ;
|
manifest>> dup [
|
||||||
|
'[ _ _ search-manifest ] [ drop f ] recover
|
||||||
|
] [ 2drop f ] if ;
|
||||||
|
|
||||||
M: char-completion (word-at-caret)
|
M: char-completion (word-at-caret)
|
||||||
2drop f ;
|
2drop f ;
|
||||||
|
|
|
@ -609,3 +609,15 @@ EXCLUDE: qualified.tests.bar => x ;
|
||||||
[ t ] [
|
[ t ] [
|
||||||
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
"z" "parser.tests.forward-ref-3" lookup def>> [ vocabulary>> ] map all-equal?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
[ [ dup ] ] [
|
||||||
|
"USE: kernel dup" <string-reader> "unuse-test" parse-stream
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"dup" <string-reader> "unuse-test" parse-stream
|
||||||
|
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
||||||
|
|
||||||
|
[
|
||||||
|
"USE: kernel UNUSE: kernel dup" <string-reader> "unuse-test" parse-stream
|
||||||
|
] [ error>> error>> error>> no-word-error? ] must-fail-with
|
|
@ -8,8 +8,21 @@ IN: vocabs.parser
|
||||||
|
|
||||||
ERROR: no-word-error name ;
|
ERROR: no-word-error name ;
|
||||||
|
|
||||||
|
: word-restarts ( possibilities -- restarts )
|
||||||
|
natural-sort
|
||||||
|
[ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc ;
|
||||||
|
|
||||||
|
: word-restarts-with-defer ( name possibilities -- restarts )
|
||||||
|
word-restarts
|
||||||
|
swap "Defer word in current vocabulary" swap 2array
|
||||||
|
suffix ;
|
||||||
|
|
||||||
|
: <no-word-error> ( name possibilities -- error restarts )
|
||||||
|
[ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;
|
||||||
|
|
||||||
TUPLE: manifest
|
TUPLE: manifest
|
||||||
current-vocab
|
current-vocab
|
||||||
|
{ search-vocab-names hashtable }
|
||||||
{ search-vocabs vector }
|
{ search-vocabs vector }
|
||||||
{ qualified-vocabs vector }
|
{ qualified-vocabs vector }
|
||||||
{ extra-words vector }
|
{ extra-words vector }
|
||||||
|
@ -17,6 +30,7 @@ current-vocab
|
||||||
|
|
||||||
: <manifest> ( -- manifest )
|
: <manifest> ( -- manifest )
|
||||||
manifest new
|
manifest new
|
||||||
|
H{ } clone >>search-vocab-names
|
||||||
V{ } clone >>search-vocabs
|
V{ } clone >>search-vocabs
|
||||||
V{ } clone >>qualified-vocabs
|
V{ } clone >>qualified-vocabs
|
||||||
V{ } clone >>extra-words
|
V{ } clone >>extra-words
|
||||||
|
@ -24,6 +38,7 @@ current-vocab
|
||||||
|
|
||||||
M: manifest clone
|
M: manifest clone
|
||||||
call-next-method
|
call-next-method
|
||||||
|
[ clone ] change-search-vocab-names
|
||||||
[ clone ] change-search-vocabs
|
[ clone ] change-search-vocabs
|
||||||
[ clone ] change-qualified-vocabs
|
[ clone ] change-qualified-vocabs
|
||||||
[ clone ] change-extra-words
|
[ clone ] change-extra-words
|
||||||
|
@ -40,12 +55,10 @@ C: <extra-words> extra-words
|
||||||
|
|
||||||
: clear-manifest ( -- )
|
: clear-manifest ( -- )
|
||||||
manifest get
|
manifest get
|
||||||
|
[ search-vocab-names>> clear-assoc ]
|
||||||
[ search-vocabs>> delete-all ]
|
[ search-vocabs>> delete-all ]
|
||||||
[ qualified-vocabs>> delete-all ]
|
[ qualified-vocabs>> delete-all ]
|
||||||
bi ;
|
tri ;
|
||||||
|
|
||||||
: (use-vocab) ( vocab -- vocab seq )
|
|
||||||
load-vocab manifest get search-vocabs>> ;
|
|
||||||
|
|
||||||
: (add-qualified) ( qualified -- )
|
: (add-qualified) ( qualified -- )
|
||||||
manifest get qualified-vocabs>> push ;
|
manifest get qualified-vocabs>> push ;
|
||||||
|
@ -87,19 +100,33 @@ TUPLE: no-current-vocab ;
|
||||||
manifest get current-vocab>> vocab-name ".private" ?tail
|
manifest get current-vocab>> vocab-name ".private" ?tail
|
||||||
[ set-current-vocab ] [ drop ] if ;
|
[ set-current-vocab ] [ drop ] if ;
|
||||||
|
|
||||||
: use-vocab ( vocab -- ) (use-vocab) push ;
|
: using-vocab? ( vocab -- ? )
|
||||||
|
vocab-name manifest get search-vocab-names>> key? ;
|
||||||
|
|
||||||
|
: use-vocab ( vocab -- )
|
||||||
|
dup using-vocab?
|
||||||
|
[ drop ] [
|
||||||
|
manifest get
|
||||||
|
[ [ vocab-name ] dip search-vocab-names>> conjoin ]
|
||||||
|
[ [ load-vocab ] dip search-vocabs>> push ]
|
||||||
|
2bi
|
||||||
|
] if ;
|
||||||
|
|
||||||
: auto-use-vocab ( vocab -- )
|
: auto-use-vocab ( vocab -- )
|
||||||
[ use-vocab ] [ manifest get auto-used>> push ] bi ;
|
[ use-vocab ] [ manifest get auto-used>> push ] bi ;
|
||||||
|
|
||||||
: auto-used? ( -- ? ) manifest get auto-used>> length 0 > ;
|
: auto-used? ( -- ? ) manifest get auto-used>> length 0 > ;
|
||||||
|
|
||||||
: unuse-vocab ( vocab -- ) (use-vocab) delq ;
|
: unuse-vocab ( vocab -- )
|
||||||
|
dup using-vocab? [
|
||||||
|
manifest get
|
||||||
|
[ [ vocab-name ] dip search-vocab-names>> delete-at ]
|
||||||
|
[ [ load-vocab ] dip search-vocabs>> delq ]
|
||||||
|
2bi
|
||||||
|
] [ drop ] if ;
|
||||||
|
|
||||||
: only-use-vocabs ( vocabs -- )
|
: only-use-vocabs ( vocabs -- )
|
||||||
clear-manifest
|
clear-manifest [ vocab ] filter [ use-vocab ] each ;
|
||||||
[ vocab ] V{ } map-as sift
|
|
||||||
manifest get search-vocabs>> push-all ;
|
|
||||||
|
|
||||||
TUPLE: qualified vocab prefix words ;
|
TUPLE: qualified vocab prefix words ;
|
||||||
|
|
||||||
|
@ -141,7 +168,10 @@ TUPLE: rename word vocab words ;
|
||||||
|
|
||||||
: unuse-words ( assoc -- ) (use-words) delete ;
|
: unuse-words ( assoc -- ) (use-words) delete ;
|
||||||
|
|
||||||
ERROR: ambiguous-use-error words ;
|
TUPLE: ambiguous-use-error words ;
|
||||||
|
|
||||||
|
: <ambiguous-use-error> ( words -- error restarts )
|
||||||
|
[ \ ambiguous-use-error boa ] [ word-restarts ] bi ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
@ -154,7 +184,10 @@ ERROR: ambiguous-use-error words ;
|
||||||
(vocab-search) {
|
(vocab-search) {
|
||||||
{ 0 [ drop f ] }
|
{ 0 [ drop f ] }
|
||||||
{ 1 [ first ] }
|
{ 1 [ first ] }
|
||||||
[ drop ambiguous-use-error ]
|
[
|
||||||
|
drop <ambiguous-use-error> throw-restarts
|
||||||
|
dup [ vocabulary>> ] [ name>> 1array ] bi add-words-from
|
||||||
|
]
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
: qualified-search ( name manifest -- word/f )
|
: qualified-search ( name manifest -- word/f )
|
||||||
|
@ -168,12 +201,3 @@ PRIVATE>
|
||||||
|
|
||||||
: search ( name -- word/f )
|
: search ( name -- word/f )
|
||||||
manifest get search-manifest ;
|
manifest get search-manifest ;
|
||||||
|
|
||||||
: word-restarts ( name possibilities -- restarts )
|
|
||||||
natural-sort
|
|
||||||
[ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc
|
|
||||||
swap "Defer word in current vocabulary" swap 2array
|
|
||||||
suffix ;
|
|
||||||
|
|
||||||
: <no-word-error> ( name possibilities -- error restarts )
|
|
||||||
[ drop \ no-word-error boa ] [ word-restarts ] 2bi ;
|
|
||||||
|
|
Loading…
Reference in New Issue