Merge branch 'master' of git://factorcode.org/git/factor

basis/help/handbook/handbook.factor

@@ -49,6 +49,7 @@ $nl
     { "associative mapping" { "an object whose class implements the " { $link "assocs-protocol" } } }
     { "boolean"               { { $link t } " or " { $link f } } }
     { "class"                 { "a set of objects identified by a " { $emphasis "class word" } " together with a discriminating predicate. See " { $link "classes" } } }
+    { "combinator"            { "a word taking a quotation or another word as input; a higher-order function. See " { $link "combinators" } } }
     { "definition specifier"  { "an instance of " { $link definition } " which implements the " { $link "definition-protocol" } } }
     { "generalized boolean"   { "an object interpreted as a boolean; a value of " { $link f } " denotes false and anything else denotes true" } }
     { "generic word"          { "a word whose behavior depends can be specialized on the class of one of its inputs. See " { $link "generic" } } }
@@ -56,6 +57,7 @@ $nl
     { "object"                { "any datum which can be identified" } }
     { "ordering specifier"    { "see " { $link "order-specifiers" } } }
     { "pathname string"       { "an OS-specific pathname which identifies a file" } }
+    { "quotation"             { "an anonymous function; an instance of the " { $link quotation } " class. More generally, instances of the " { $link callable } " class can be used in many places documented to expect quotations" } }
     { "sequence" { "a sequence; see " { $link "sequence-protocol" } } }
     { "slot"                  { "a component of an object which can store a value" } }
     { "stack effect"          { "a pictorial representation of a word's inputs and outputs, for example " { $snippet "+ ( x y -- z )" } ". See " { $link "effects" } } }

basis/opengl/capabilities/capabilities.factor

@@ -32,6 +32,8 @@ IN: opengl.capabilities
     (gl-version) drop ;
 : gl-vendor-version ( -- version )
     (gl-version) nip ;
+: gl-vendor ( -- name )
+    GL_VENDOR glGetString ;
 : has-gl-version? ( version -- ? )
     gl-version version-before? ;
 : (make-gl-version-error) ( required-version -- )

basis/opengl/textures/textures.factor

@@ -1,13 +1,23 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs cache colors.constants destructors fry kernel
-opengl opengl.gl combinators images images.tesselation grouping
+opengl opengl.gl opengl.capabilities combinators images
-specialized-arrays.float sequences math math.vectors
+images.tesselation grouping specialized-arrays.float sequences math
-math.matrices generalizations fry arrays namespaces ;
+math.vectors math.matrices generalizations fry arrays namespaces
+system ;
 IN: opengl.textures
 
 SYMBOL: non-power-of-2-textures?
 
+: check-extensions ( -- )
+    #! ATI frglx driver doesn't implement GL_ARB_texture_non_power_of_two properly.
+    #! See thread 'Linux font display problem' April 2009 on Factor-talk
+    gl-vendor "ATI Technologies Inc." = not os macosx? or [
+        "2.0" { "GL_ARB_texture_non_power_of_two" }
+        has-gl-version-or-extensions?
+        non-power-of-2-textures? set
+    ] when ;
+
 : gen-texture ( -- id ) [ glGenTextures ] (gen-gl-object) ;
 
 : delete-texture ( id -- ) [ glDeleteTextures ] (delete-gl-object) ;

basis/ui/backend/cocoa/cocoa.factor

@@ -70,8 +70,8 @@ M:: cocoa-ui-backend (open-window) ( world -- )
     world dim>> <FactorView> :> view
     view world world>NSRect <ViewWindow> :> window
     view -> release
-    window world window-loc>> auto-position
     world view register-window
+    window world window-loc>> auto-position
     world window save-position
     window install-window-delegate
     view window <window-handle> world (>>handle)

basis/ui/backend/cocoa/views/views.factor

@@ -336,7 +336,7 @@ CLASS: {
 
 ! Initialization
 { "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
-    [ 2drop dup view-dim swap window (>>dim) yield ]
+    [ 2drop [ window ] [ view-dim ] bi >>dim drop yield ]
 }
 
 { "doCommandBySelector:" "void" { "id" "SEL" "SEL" }

basis/ui/gadgets/worlds/worlds.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays assocs continuations kernel math models
-namespaces opengl opengl.capabilities opengl.textures sequences io
+namespaces opengl opengl.textures sequences io combinators
-combinators combinators.short-circuit fry math.vectors math.rectangles
+combinators.short-circuit fry math.vectors math.rectangles cache
-cache ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
+ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
 ui.commands ;
 IN: ui.gadgets.worlds
 
@@ -77,10 +77,6 @@ SYMBOL: flush-layout-cache-hook
 
 flush-layout-cache-hook [ [ ] ] initialize
 
-: check-extensions ( -- )
-    "2.0" { "GL_ARB_texture_non_power_of_two" } has-gl-version-or-extensions?
-    non-power-of-2-textures? set ;
-
 : (draw-world) ( world -- )
     dup handle>> [
         check-extensions

basis/ui/ui.factor

@@ -12,7 +12,10 @@ IN: ui
 ! Assoc mapping aliens to gadgets
 SYMBOL: windows
 
-: window ( handle -- world ) windows get-global at ;
+ERROR: no-window handle ;
+
+: window ( handle -- world )
+    windows get-global ?at [ no-window ] unless ;
 
 : window-focus ( handle -- gadget ) window world-focus ;
 

basis/urls/encoding/encoding-tests.factor

@@ -26,3 +26,7 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ;
 [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test
 
 [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test
+
+[ "a" ] [ { { "a" f } } assoc>query ] unit-test
+
+[ H{ { "a" f } } ] [ "a" query>assoc ] unit-test

basis/urls/encoding/encoding.factor

@@ -72,6 +72,15 @@ PRIVATE>
         ] when*
     ] 2keep set-at ;
 
+: assoc-strings ( assoc -- assoc' )
+    [
+        {
+            { [ dup not ] [ ] }
+            { [ dup array? ] [ [ present ] map ] }
+            [ present 1array ]
+        } cond
+    ] assoc-map ;
+
 PRIVATE>
 
 : query>assoc ( query -- assoc )
@@ -86,11 +95,8 @@ PRIVATE>
 
 : assoc>query ( assoc -- str )
     [
-        dup array? [ [ present ] map ] [ present 1array ] if
+        assoc-strings [
-    ] assoc-map
-    [
-        [
             [ url-encode ] dip
-            [ url-encode "=" glue , ] with each
+            [ [ url-encode "=" glue , ] with each ] [ , ] if*
         ] assoc-each
     ] { } make "&" join ;

basis/urls/urls-tests.factor

@@ -80,6 +80,15 @@ CONSTANT: urls
             }
             "ftp://slava:secret@ftp.kernel.org/"
         }
+        {
+            T{ url
+               { protocol "http" }
+               { host "foo.com" }
+               { path "/" }
+               { query H{ { "a" f } } }
+            }
+            "http://foo.com/?a"
+        }
     }
 
 urls [

core/classes/tuple/tuple-docs.factor

@@ -92,7 +92,7 @@ ARTICLE: "tuple-constructors" "Tuple constructors"
 $nl
 "Constructors play a part in enforcing the invariant that slot values must always match slot declarations. The " { $link new } " word fills in the tuple with initial values, and " { $link boa } " ensures that the values on the stack match the corresponding slot declarations. See " { $link "tuple-declarations" } "."
 $nl
-"All tuple construction should be done through constructor words, and construction primitives should be encapsulated and never called outside of the vocabulary where the class is defined, because this encourages looser coupling. For example, a constructor word could be changed to use memoization instead of always constructing a new instance, or it could be changed to construt a different class, without breaking callers."
+"All tuple construction should be done through constructor words, and construction primitives should be encapsulated and never called outside of the vocabulary where the class is defined, because this encourages looser coupling. For example, a constructor word could be changed to use memoization instead of always constructing a new instance, or it could be changed to construct a different class, without breaking callers."
 $nl
 "Examples of constructors:"
 { $code
@@ -220,13 +220,13 @@ ARTICLE: "tuple-examples" "Tuple examples"
     "    <employee> \"project manager\" >>position ;" }
 "An alternative strategy is to define the most general BOA constructor first:"
 { $code
-    ": <employee> ( name position -- person )"
+    ": <employee> ( name position -- employee )"
     "    40000 employee boa ;"
 }
 "Now we can define more specific constructors:"
 { $code
-    ": <manager> ( name -- person )"
+    ": <manager> ( name -- employee )"
-    "    \"manager\" <person> ;" }
+    "    \"manager\" <employee> ;" }
 "An example using reader words:"
 { $code
     "TUPLE: check to amount number ;"
@@ -256,7 +256,7 @@ ARTICLE: "tuple-examples" "Tuple examples"
     ": next-position ( role -- newrole )"
     "    positions [ index 1+ ] keep nth ;"
     ""
-    ": promote ( person -- person )"
+    ": promote ( employee -- employee )"
     "    [ 1.2 * ] change-salary"
     "    [ next-position ] change-position ;"
 }