made it an error to reference non-existent vocabularies in a USE: declaration; fixed this error in library source files

CHANGES.html

@@ -43,6 +43,8 @@ rather than an association list for specifying style information.</li>
 <li>UI changes:
 
 <ul>
+<li>A left click on a presentation now invokes the default command. A right click
+shows a menu of possibilities.</li>
 <li>Fixed invalid OpenGL calls which caused problems on Windows machines with ATI
 drivers, and Linux machines with the MesaGL implementation.</li>
 </ul>

library/alien/structs.factor

@@ -38,4 +38,4 @@ sequences strings words ;
         cell get "align" set
         [ swap <displaced-alien> ] "getter" set
     ] "struct-name" get define-c-type
-    "struct-name" get "in" get init-c-type ;
+    "struct-name" get in get init-c-type ;

library/collections/hashtables.factor

@@ -262,6 +262,10 @@ M: hashtable = ( obj hash -- ? )
     #! Add all key/value pairs from hash2 to hash1.
     [ swap rot set-hash ] hash-each-with ;
 
+: hash-concat ( seq -- hash )
+    #! Combine a sequence of hashtables into one hashtable.
+    H{ } clone swap [ dupd hash-update ] each ;
+
 : hash-union ( hash1 hash2 -- hash1\/hash2 )
     #! Make a new hashtable with all key/value pairs from
     #! hash1 and hash2. Values in hash2 take precedence.

library/generic/slots.factor

@@ -40,11 +40,10 @@ parser sequences strings words ;
     [ first3 define-slot ] each-with ;
 
 : reader-word ( class name -- word )
-    >r word-name "-" r> append3 "in" get 2array ;
+    >r word-name "-" r> append3 in get 2array ;
 
 : writer-word ( class name -- word )
-    [ swap "set-" % word-name % "-" % % ] "" make
+    [ swap "set-" % word-name % "-" % % ] "" make in get 2array ;
-    "in" get 2array ;
 
 : simple-slot ( class name -- reader writer )
     [ reader-word ] 2keep writer-word ;

library/generic/tuple.factor

@@ -32,7 +32,7 @@ vectors words ;
 : check-shape ( word slots -- )
     #! If the new list of slots is different from the previous,
     #! forget the old definition.
-    >r "in" get lookup dup [
+    >r in get lookup dup [
         dup "tuple-size" word-prop r> length 2 + =
         [ drop ] [ forget-tuple ] if
     ] [
@@ -49,7 +49,7 @@ vectors words ;
     define-slots ;
 
 : tuple-constructor ( class -- word )
-    word-name "in" get constructor-word dup save-location ;
+    word-name in get constructor-word dup save-location ;
 
 PREDICATE: word tuple-class "tuple-size" word-prop ;
 

library/inference/optimizer.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: optimizer
 USING: compiler-backend generic hashtables inference kernel
-lists math matrices namespaces sequences vectors ;
+lists math namespaces sequences vectors ;
 
 ! We use the recursive-state variable here, to track nested
 ! label scopes, to prevent infinite loops when inlining

library/io/c-streams.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: io-internals
-USING: errors kernel kernel-internals namespaces io
+USING: errors kernel kernel-internals namespaces io strings ;
-strings threads ;
 
 ! Simple wrappers for ANSI C I/O functions, used for
 ! bootstrapping only.

library/syntax/parse-stream.factor

@@ -4,8 +4,7 @@ IN: parser
 USING: errors io kernel lists math namespaces sequences words ;
 
 : file-vocabs ( -- )
-    "scratchpad" "in" set
+    "scratchpad" set-in { "syntax" "scratchpad" } set-use ;
-    [ "syntax" "scratchpad" ] "use" set ;
 
 : parse-lines ( lines -- quot )
     [

library/syntax/parse-syntax.factor

@@ -96,7 +96,7 @@ SYMBOL: t
     #! Followed by a word name. The word is removed from its
     #! vocabulary. Note that specifying an undefined word is a
     #! no-op.
-    scan "use" get search [ forget ] when* ; parsing
+    scan use get hash-stack [ forget ] when* ; parsing
 
 : USE:
     #! Add vocabulary to search path.
@@ -110,7 +110,7 @@ SYMBOL: t
 
 : IN:
     #! Set vocabulary for new definitions.
-    scan dup use+ "in" set ; parsing
+    scan set-in ; parsing
 
 ! Char literal
 : CHAR: ( -- ) 0 scan next-char drop swons ; parsing

library/syntax/parse-words.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: parser
-USING: errors hashtables kernel lists math namespaces sequences
+USING: errors hashtables io kernel lists math namespaces
-io strings words ;
+sequences strings vectors words ;
 
 ! The parser uses a number of variables:
 ! line - the line being parsed
@@ -14,14 +14,28 @@ io strings words ;
 ! of vocabularies. If it is a parsing word, it is executed
 ! immediately. Otherwise it is appended to the parse tree.
 
-SYMBOL: line-number
+SYMBOL: use
+SYMBOL: in
 
-: use+ ( string -- ) "use" [ cons ] change ;
+: check-vocab ( name -- vocab )
+    dup vocab
+    [ ] [ " is not a vocabulary name" append throw ] ?if ;
+
+: use+ ( string -- )
+    #! Add a vocabulary to the search path.
+    check-vocab use get push ;
+
+: set-use ( seq -- )
+    [ check-vocab ] map >vector use set ;
+
+: set-in ( name -- )
+    dup ensure-vocab dup in set use+ ;
 
 : parsing? ( word -- ? )
     dup word? [ "parsing" word-prop ] [ drop f ] if ;
 
 SYMBOL: file
+SYMBOL: line-number
 
 : skip ( i seq quot -- n | quot: elt -- ? )
     over >r find* drop dup -1 =
@@ -48,7 +62,7 @@ SYMBOL: file
     dup "col" get "col"  set-word-prop
     file get "file" set-word-prop ;
 
-: create-in "in" get create dup save-location ;
+: create-in in get create dup save-location ;
 
 : CREATE ( -- word ) scan create-in ;
 
@@ -60,7 +74,7 @@ global [ string-mode off ] bind
 : scan-word ( -- obj )
     scan dup [
         dup ";" = not string-mode get and [
-            dup "use" get search [ ] [ string>number ] ?if
+            dup use get hash-stack [ ] [ string>number ] ?if
         ] unless
     ] when ;
 
@@ -150,3 +164,16 @@ global [ string-mode off ] bind
     "col" [
         [ "line" get (parse-string) ] "" make swap
     ] change ;
+
+global [
+    {
+        "scratchpad"
+        "syntax" "arrays" "compiler" "errors" "generic" "hashtables"
+        "help" "inference" "inspector" "interpreter" "io"
+        "jedit" "kernel" "listener" "lists" "math"
+        "memory" "namespaces" "parser" "prettyprint" "queues"
+        "sequences" "shells" "strings" "styles"
+        "test" "threads" "vectors" "words"
+    } set-use
+    "scratchpad" set-in
+] bind

library/test/collections/hashtables.factor

@@ -190,3 +190,8 @@ H{ } clone "cache-test" set
 ] unit-test
 
 [ { 1 3 } ] [ H{ { 2 2 } } { 1 2 3 } remove-all ] unit-test
+
+[ H{ } ] [ { } hash-concat ] unit-test
+[ H{ } ] [ { H{ } } hash-concat ] unit-test
+[ H{ { 1 2 } } ] [ { H{ { 1 2 } } } hash-concat ] unit-test
+[ H{ { 1 2 } { 3 4 } } ] [ { H{ { 1 2 } } H{ { 3 4 } } } hash-concat ] unit-test

library/test/collections/vectors.factor

@@ -1,6 +1,6 @@
 IN: temporary
 USING: errors kernel kernel-internals lists math namespaces
-random sequences sequences-internals strings test vectors ;
+sequences sequences-internals strings test vectors ;
 
 [ ] [ 10 [ [ -1000000 <vector> ] catch drop ] times ] unit-test
 

library/test/inference.factor

@@ -175,9 +175,6 @@ DEFER: agent
 [ { 0 2 } ]
 [ [ [ drop ] 0 agent ] infer ] unit-test
 
-! : no-base-case-1 dup [ no-base-case-1 ] [ no-base-case-1 ] if ;
-! [ [ no-base-case-1 ] infer ] unit-test-fails
-
 : no-base-case-2 no-base-case-2 ;
 [ [ no-base-case-2 ] infer ] unit-test-fails
 
@@ -214,6 +211,12 @@ DEFER: blah4
 
 [ [ [ 1 ] [ ] bad-combinator ] infer ] unit-test-fails
 
+! Regression
+DEFER: do-crap
+: more-crap dup [ drop ] [ dup do-crap call ] if ;
+: do-crap dup [ do-crap ] [ more-crap ] if ;
+[ [ do-crap ] infer ] unit-test-fails
+
 [ { 2 1 } ] [ [ swons ] infer ] unit-test
 [ { 1 2 } ] [ [ uncons ] infer ] unit-test
 [ { 1 1 } ] [ [ unit ] infer ] unit-test
@@ -275,3 +278,6 @@ DEFER: blah4
 ! This hangs
 
 ! [ ] [ [ [ dup call ] dup call ] infer ] unit-test-fails
+
+! : no-base-case-1 dup [ no-base-case-1 ] [ no-base-case-1 ] if ;
+! [ [ no-base-case-1 ] infer ] unit-test-fails

library/tools/annotations.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: words
 USING: interpreter inspector io kernel lists math namespaces
-prettyprint sequences strings test ;
+prettyprint sequences strings ;
 
 ! The annotation words let you flag a word for either tracing
 ! or single-stepping. Note that currently, words referring to

library/tools/jedit.factor

@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: jedit
 USING: arrays errors io kernel listener lists math namespaces
-parser prettyprint sequences strings unparser words ;
+parser prettyprint sequences strings words ;
 
 ! Some words to send requests to a running jEdit instance to
 ! edit files and position the cursor on a specific line number.
@@ -84,6 +84,9 @@ parser prettyprint sequences strings unparser words ;
 : telnetd ( port -- )
     \ telnetd [ print-banner listener ] with-server ;
 
+: search ( name vocabs -- word )
+    dupd [ lookup ] find-with nip lookup ;
+
 IN: shells
 
 : telnet

library/tools/listener.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: listener
-USING: errors io kernel lists math memory namespaces parser
+USING: errors hashtables io kernel lists math memory namespaces
-presentation sequences strings styles vectors words ;
+parser sequences strings styles vectors words ;
 
 SYMBOL: listener-prompt
 SYMBOL: quit-flag
@@ -11,7 +11,7 @@ SYMBOL: listener-hook
 SYMBOL: datastack-hook
 SYMBOL: callstack-hook
 
-global [ "  " listener-prompt set ] bind
+"  " listener-prompt global set-hash
 
 : bye ( -- )
     #! Exit the current listener.
@@ -40,9 +40,14 @@ global [ "  " listener-prompt set ] bind
     listener-prompt get write flush
     [ read-multiline [ call ] [ bye ] if ] try ;
 
+: (listener) ( -- )
+    quit-flag get [ quit-flag off ] [ listen (listener) ] if ;
+
 : listener ( -- )
-    #! Run a listener loop that executes user input.
+    #! Run a listener loop that executes user input. We start
-    quit-flag get [ quit-flag off ] [ listen listener ] if ;
+    #! the listener in a new scope and copy the vocabulary
+    #! search path.
+    [ use [ clone ] change (listener) ] with-scope ;
 
 : credits ( -- )
     "Slava Pestov:       dup drop swap >r r>" print

library/tools/memory.factor

@@ -3,7 +3,7 @@
 IN: memory
 USING: arrays errors generic hashtables io kernel
 kernel-internals lists math namespaces parser prettyprint
-sequences strings unparser vectors words ;
+sequences strings vectors words ;
 
 : generations ( -- n ) 15 getenv ;
 

library/ui/hand.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: alien generic io kernel lists math matrices namespaces
+USING: kernel math namespaces sequences ;
-prettyprint sequences vectors ;
 
 ! The hand is a special gadget that holds mouse position and
 ! mouse button click state.
@@ -16,19 +15,16 @@ TUPLE: hand click-loc click-rel clicked buttons gadget focus ;
 C: hand ( -- hand )
     dup delegate>gadget V{ } clone over set-hand-buttons ;
 
-: (button-gesture) ( buttons gesture -- )
+: button-gesture ( buttons gesture -- )
-    swap hand get hand-clicked 3dup >r append r> handle-gesture
-    [ nip handle-gesture drop ] [ 3drop ] if ;
-
-: button-gesture ( button gesture -- )
     #! Send a gesture like [ button-down 2 ]; if nobody
     #! handles it, send [ button-down ].
-    >r unit r> (button-gesture) ;
+    swap hand get hand-clicked 3dup >r add r> handle-gesture
+    [ nip handle-gesture drop ] [ 3drop ] if ;
 
 : drag-gesture ( -- )
     #! Send a gesture like [ drag 2 ]; if nobody handles it,
     #! send [ drag ].
-    hand get hand-buttons [ drag ] (button-gesture) ;
+    hand get hand-buttons first [ drag ] button-gesture ;
 
 : fire-motion ( hand -- )
     #! Fire a motion gesture to the gadget underneath the hand,

library/ui/listener.factor

@@ -7,8 +7,8 @@ IN: gadgets-listener
 USING: gadgets gadgets-editors gadgets-labels gadgets-layouts
 gadgets-panes gadgets-presentations gadgets-scrolling
 gadgets-splitters gadgets-theme generic hashtables help
-inspector io kernel listener lists math namespaces prettyprint
+inspector io kernel listener lists math namespaces parser
-sdl sequences shells styles threads words ;
+prettyprint sdl sequences shells styles threads words ;
 
 SYMBOL: datastack-display
 SYMBOL: callstack-display
@@ -39,7 +39,7 @@ C: display ( -- display )
     callstack-hook get call callstack-display get present-stack ;
 
 : usable-words ( -- words )
-    "use" get prune [ words ] map concat ;
+    use get hash-concat hash-keys ;
 
 : word-completion ( -- )
     usable-words [ word-name ] map

library/ui/paragraphs.factor

@@ -46,7 +46,7 @@ SYMBOL: margin
     [
         swap dup init-wrap
         gadget-children [ wrap-step ] each-with wrap-dim
-    ] with-scope ;
+    ] with-scope ; inline
 
 M: paragraph pref-dim ( paragraph -- dim )
     [ 2drop ] do-wrap ;

library/ui/scrolling.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets-scrolling
-USING: arrays gadgets gadgets-books gadgets-layouts generic kernel
+USING: arrays gadgets gadgets-layouts kernel math namespaces
-lists math namespaces sequences styles threads ;
+sequences ;
 
 ! A viewport can be scrolled.
 TUPLE: viewport ;

library/vocabularies.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: words
-USING: hashtables errors kernel lists namespaces strings
+USING: errors hashtables kernel lists namespaces sequences
-sequences ;
+strings ;
 
 ! If true in current namespace, we are bootstrapping.
 SYMBOL: bootstrapping?
@@ -20,6 +20,10 @@ SYMBOL: vocabularies
     #! Get a vocabulary.
     vocabularies get hash ;
 
+: ensure-vocab ( name -- )
+    #! Create the vocabulary if it does not exist.
+    vocabularies get [ nest drop ] bind ;
+
 : words ( vocab -- list )
     #! Push a list of all words in a vocabulary.
     #! Filter empty slots.
@@ -45,9 +49,6 @@ SYMBOL: vocabularies
 
 : lookup ( name vocab -- word ) vocab ?hash ;
 
-: search ( name vocabs -- word )
-    dupd [ lookup ] find-with nip lookup ;
-
 : reveal ( word -- )
     #! Add a new word to its vocabulary.
     vocabularies get [
@@ -86,14 +87,3 @@ SYMBOL: vocabularies
     bootstrapping? get [
         dup "syntax" = [ drop "!syntax" ] when
     ] when lookup ;
-
-"scratchpad" "in" set
-[
-    "scratchpad"
-    "syntax" "arrays" "compiler" "errors" "generic" "hashtables"
-    "help" "inference" "inspector" "interpreter" "io"
-    "jedit" "kernel" "listener" "lists" "math"
-    "memory" "namespaces" "parser" "prettyprint" "queues"
-    "sequences" "shells" "strings" "styles"
-    "test" "threads" "vectors" "words"
-] "use" set