Merge branch 'master' of git://github.com/seckar/factor

diff --git a/Factor.app/Contents/Frameworks/libfreetype.6.dylib b/Factor.app/Contents/Frameworks/libfreetype.6.dylib
deleted file mode 100755 (executable)
index 381e74b..0000000
Binary files a/Factor.app/Contents/Frameworks/libfreetype.6.dylib and /dev/null differ

diff --git a/basis/help/tips/tips-docs.factor b/basis/help/tips/tips-docs.factor
index 8d732c55680ae0ff60ae0150c0a3200f83bc6dca..750eff7a52b7d8b1fda97ef0ba5c1427f5873434 100644 (file)
--- a/basis/help/tips/tips-docs.factor
+++ b/basis/help/tips/tips-docs.factor
@@ -17,7 +17,14 @@ TIP: "You can write documentation for your own code using the " { $link "help" }
 TIP: "You can write graphical applications using the " { $link "ui" } "." ;
 
 TIP: "Power tools: " { $links see edit help about apropos time infer. } ;
- 
+
+TIP: "Tips of the day implement the " { $link "definition-protocol" } " and new tips of the day can be defined using the " { $link POSTPONE: TIP: } " parsing word." ;
+
+HELP: TIP:
+{ $syntax "TIP: content ;" }
+{ $values { "content" "a markup element" } }
+{ $description "Defines a new tip of the day." } ;
+  
 ARTICLE: "all-tips-of-the-day" "All tips of the day"
 { $tips-of-the-day } ;
 

diff --git a/basis/help/tips/tips.factor b/basis/help/tips/tips.factor
index 8d173ce533a2348885a8c55d259c355f5a266b9e..4685b6c5172f364ccea9bea9eb69f0eb4ab1c1d7 100644 (file)
--- a/basis/help/tips/tips.factor
+++ b/basis/help/tips/tips.factor
@@ -1,14 +1,28 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser arrays namespaces sequences random help.markup kernel io
-io.styles colors.constants ;
+USING: parser arrays namespaces sequences random help.markup help.stylesheet
+kernel io io.styles colors.constants definitions accessors ;
 IN: help.tips
 
 SYMBOL: tips
 
 tips [ V{ } clone ] initialize
 
-SYNTAX: TIP: parse-definition >array tips get push ;
+TUPLE: tip < identity-tuple content loc ;
+
+M: tip forget* tips get delq ;
+
+M: tip where loc>> ;
+
+M: tip set-where (>>loc) ;
+
+: <tip> ( content -- tip ) f tip boa ;
+
+: add-tip ( tip -- ) tips get push ;
+
+SYNTAX: TIP:
+    parse-definition >array <tip>
+    [ save-location ] [ add-tip ] bi ;
 
 : a-tip ( -- tip ) tips get random ;
 
@@ -20,13 +34,20 @@ H{
     { wrap-margin 500 }
 } tip-of-the-day-style set-global
 
+: $tip-title ( tip -- )
+    [
+        heading-style get [
+            [ "Tip of the day" ] dip write-object
+        ] with-style
+    ] ($block) ;
+
 : $tip-of-the-day ( element -- )
     drop
     [
         tip-of-the-day-style get
         [
             last-element off
-            "Tip of the day" $heading a-tip print-element nl
+            a-tip [ $tip-title ] [ content>> print-element nl ] bi
             "— " print-element "all-tips-of-the-day" ($link)
         ]
         with-nesting
@@ -35,4 +56,6 @@ H{
 : tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ;
 
 : $tips-of-the-day ( element -- )
-    drop tips get [ nl nl ] [ print-element ] interleave ;
\ No newline at end of file
+    drop tips get [ nl nl ] [ content>> print-element ] interleave ;
+
+INSTANCE: tip definition
\ No newline at end of file

diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor
index 864b030126947b5f1d1b41441da555169c194359..a251849e8f87fa2507a15d4f2a91fa2f8864bbfd 100644 (file)
--- a/basis/help/topics/topics.factor
+++ b/basis/help/topics/topics.factor
@@ -7,8 +7,12 @@ IN: help.topics
 
 TUPLE: link name ;
 
+INSTANCE: link definition
+
 MIXIN: topic
+
 INSTANCE: link topic
+
 INSTANCE: word topic
 
 GENERIC: >link ( obj -- obj )

diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor
index 52684e55f59ab19195f37c5f6d9a42a06e344bd6..597367c3532eff85aad9dc0c9c65fd0e2b1a5bfc 100644 (file)
--- a/basis/hints/hints.factor
+++ b/basis/hints/hints.factor
@@ -34,16 +34,18 @@ M: object specializer-declaration class ;
         [ specializer-declaration ] map '[ _ declare ] pick append
     ] { } map>assoc ;
 
+: specialize-quot ( quot specializer -- quot' )
+    specializer-cases alist>quot ;
+
 : method-declaration ( method -- quot )
     [ "method-generic" word-prop dispatch# object <array> ]
     [ "method-class" word-prop ]
     bi prefix ;
 
 : specialize-method ( quot method -- quot' )
-    method-declaration '[ _ declare ] prepend ;
-
-: specialize-quot ( quot specializer -- quot' )
-    specializer-cases alist>quot ;
+    [ method-declaration '[ _ declare ] prepend ]
+    [ "method-generic" word-prop "specializer" word-prop ] bi
+    [ specialize-quot ] when* ;
 
 : standard-method? ( method -- ? )
     dup method-body? [
@@ -52,9 +54,11 @@ M: object specializer-declaration class ;
 
 : specialized-def ( word -- quot )
     [ def>> ] keep
-    [ dup standard-method? [ specialize-method ] [ drop ] if ]
-    [ "specializer" word-prop [ specialize-quot ] when* ]
-    bi ;
+    dup generic? [ drop ] [
+        [ dup standard-method? [ specialize-method ] [ drop ] if ]
+        [ "specializer" word-prop [ specialize-quot ] when* ]
+        bi
+    ] if ;
 
 : specialized-length ( specializer -- n )
     dup [ array? ] all? [ first ] when length ;

diff --git a/basis/images/images.factor b/basis/images/images.factor
index a426c33ddc28ebee855bb79ad5ab46f4c0d6baf3..08fbdd4e7e7d46a054f7e1266a2425b3b6a896c2 100644 (file)
--- a/basis/images/images.factor
+++ b/basis/images/images.factor
@@ -1,16 +1,14 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors grouping sequences combinators
-math specialized-arrays.direct.uint byte-arrays fry
-specialized-arrays.direct.ushort specialized-arrays.uint
-specialized-arrays.ushort specialized-arrays.float ;
+USING: combinators kernel ;
 IN: images
 
-SINGLETONS: BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
+SINGLETONS: L BGR RGB BGRA RGBA ABGR ARGB RGBX XRGB BGRX XBGR
 R16G16B16 R32G32B32 R16G16B16A16 R32G32B32A32 ;
 
 : bytes-per-pixel ( component-order -- n )
     {
+        { L [ 1 ] }
         { BGR [ 3 ] }
         { RGB [ 3 ] }
         { BGRA [ 4 ] }
@@ -31,71 +29,4 @@ TUPLE: image dim component-order upside-down? bitmap ;
 
 : <image> ( -- image ) image new ; inline
 
-GENERIC: load-image* ( path tuple -- image )
-
-: add-dummy-alpha ( seq -- seq' )
-    3 <groups> [ 255 suffix ] map concat ;
-
-: normalize-floats ( byte-array -- byte-array )
-    byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
-
-GENERIC: normalize-component-order* ( image component-order -- image )
-
-: normalize-component-order ( image -- image )
-    dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
-
-M: RGBA normalize-component-order* drop ;
-
-M: R32G32B32A32 normalize-component-order*
-    drop normalize-floats ;
-
-M: R32G32B32 normalize-component-order*
-    drop normalize-floats add-dummy-alpha ;
-
-: RGB16>8 ( bitmap -- bitmap' )
-    byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
-
-M: R16G16B16A16 normalize-component-order*
-    drop RGB16>8 ;
-
-M: R16G16B16 normalize-component-order*
-    drop RGB16>8 add-dummy-alpha ;
-
-: BGR>RGB ( bitmap -- pixels )
-    3 <sliced-groups> [ <reversed> ] map B{ } join ; inline
-
-: BGRA>RGBA ( bitmap -- pixels )
-    4 <sliced-groups>
-    [ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
-
-M: BGRA normalize-component-order*
-    drop BGRA>RGBA ;
-
-M: RGB normalize-component-order*
-    drop add-dummy-alpha ;
-
-M: BGR normalize-component-order*
-    drop BGR>RGB add-dummy-alpha ;
-
-: ARGB>RGBA ( bitmap -- bitmap' )
-    4 <groups> [ unclip suffix ] map B{ } join ; inline
-
-M: ARGB normalize-component-order*
-    drop ARGB>RGBA ;
-
-M: ABGR normalize-component-order*
-    drop ARGB>RGBA BGRA>RGBA ;
-
-: normalize-scan-line-order ( image -- image )
-    dup upside-down?>> [
-        dup dim>> first 4 * '[
-            _ <groups> reverse concat
-        ] change-bitmap
-        f >>upside-down?
-    ] when ;
-
-: normalize-image ( image -- image )
-    [ >byte-array ] change-bitmap
-    normalize-component-order
-    normalize-scan-line-order
-    RGBA >>component-order ;
+GENERIC: load-image* ( path tuple -- image )
\ No newline at end of file

diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor
index 6f2ae47c61591a5b7efb0eea0d689bd2a66a402e..b8bafc021f6a85a638641b3e2f0e657c86ddd5a1 100644 (file)
--- a/basis/images/loader/loader.factor
+++ b/basis/images/loader/loader.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: constructors kernel splitting unicode.case combinators
-accessors images.bitmap images.tiff images io.backend
+accessors images.bitmap images.tiff images images.normalization
 io.pathnames ;
 IN: images.loader
 

diff --git a/basis/images/normalization/authors.txt b/basis/images/normalization/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/basis/images/normalization/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/basis/images/normalization/normalization.factor b/basis/images/normalization/normalization.factor
new file mode 100644 (file)
index 0000000..bcdf841
--- /dev/null
+++ b/basis/images/normalization/normalization.factor
@@ -0,0 +1,78 @@
+! Copyright (C) 2009 Doug Coleman
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors grouping sequences combinators
+math specialized-arrays.direct.uint byte-arrays fry
+specialized-arrays.direct.ushort specialized-arrays.uint
+specialized-arrays.ushort specialized-arrays.float images ;
+IN: images.normalization
+
+<PRIVATE
+
+: add-dummy-alpha ( seq -- seq' )
+    3 <groups> [ 255 suffix ] map concat ;
+
+: normalize-floats ( byte-array -- byte-array )
+    byte-array>float-array [ 255.0 * >integer ] B{ } map-as ;
+
+GENERIC: normalize-component-order* ( image component-order -- image )
+
+: normalize-component-order ( image -- image )
+    dup component-order>> '[ _ normalize-component-order* ] change-bitmap ;
+
+M: RGBA normalize-component-order* drop ;
+
+M: R32G32B32A32 normalize-component-order*
+    drop normalize-floats ;
+
+M: R32G32B32 normalize-component-order*
+    drop normalize-floats add-dummy-alpha ;
+
+: RGB16>8 ( bitmap -- bitmap' )
+    byte-array>ushort-array [ -8 shift ] B{ } map-as ; inline
+
+M: R16G16B16A16 normalize-component-order*
+    drop RGB16>8 ;
+
+M: R16G16B16 normalize-component-order*
+    drop RGB16>8 add-dummy-alpha ;
+
+: BGR>RGB ( bitmap -- pixels )
+    3 <sliced-groups> [ <reversed> ] map B{ } join ; inline
+
+: BGRA>RGBA ( bitmap -- pixels )
+    4 <sliced-groups>
+    [ unclip-last-slice [ <reversed> ] dip suffix ] map concat ; inline
+
+M: BGRA normalize-component-order*
+    drop BGRA>RGBA ;
+
+M: RGB normalize-component-order*
+    drop add-dummy-alpha ;
+
+M: BGR normalize-component-order*
+    drop BGR>RGB add-dummy-alpha ;
+
+: ARGB>RGBA ( bitmap -- bitmap' )
+    4 <groups> [ unclip suffix ] map B{ } join ; inline
+
+M: ARGB normalize-component-order*
+    drop ARGB>RGBA ;
+
+M: ABGR normalize-component-order*
+    drop ARGB>RGBA BGRA>RGBA ;
+
+: normalize-scan-line-order ( image -- image )
+    dup upside-down?>> [
+        dup dim>> first 4 * '[
+            _ <groups> reverse concat
+        ] change-bitmap
+        f >>upside-down?
+    ] when ;
+
+PRIVATE>
+
+: normalize-image ( image -- image )
+    [ >byte-array ] change-bitmap
+    normalize-component-order
+    normalize-scan-line-order
+    RGBA >>component-order ;

diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 4f639c02a7ce5d6cbbe29f8c5f2e42ecf5d535ae..3148567bc0a0cdf9649dbf822ce9fce4b59f0f69 100755 (executable)
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -37,7 +37,7 @@ IN: math.bitwise
 
 ! flags
 MACRO: flags ( values -- )
-    [ 0 ] [ [ dup word? [ execute ] when bitor ] curry compose ] reduce ;
+    [ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
 
 ! bitfield
 <PRIVATE

diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor
index e08a7487aec51fb941cf819d0399d1edea637c02..9e39dac20c26bd8d76251e3639befb0d3bdaeec4 100644 (file)
--- a/basis/opengl/opengl.factor
+++ b/basis/opengl/opengl.factor
@@ -28,7 +28,7 @@ IN: opengl
     over glEnableClientState dip glDisableClientState ; inline
 
 : words>values ( word/value-seq -- value-seq )
-    [ dup word? [ execute ] when ] map ;
+    [ ?execute ] map ;
 
 : (all-enabled) ( seq quot -- )
     over [ glEnable ] each dip [ glDisable ] each ; inline

diff --git a/basis/specialized-vectors/specialized-vectors-tests.factor b/basis/specialized-vectors/specialized-vectors-tests.factor
index df077ce18959e9c9f5a8586ff4290b12035a0246..82def17e4471521dff66c5e96e09de18f13a8d59 100644 (file)
--- a/basis/specialized-vectors/specialized-vectors-tests.factor
+++ b/basis/specialized-vectors/specialized-vectors-tests.factor
@@ -1,5 +1,9 @@
 IN: specialized-vectors.tests
-USING: specialized-vectors.double tools.test kernel sequences ;
+USING: specialized-arrays.float
+specialized-vectors.float
+specialized-vectors.double
+tools.test kernel sequences ;
 
 [ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
 
+[ t ] [ 10 float-array{ } new-resizable float-vector? ] unit-test
\ No newline at end of file

diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor
index 28781e24bbc2ac9a2e58a70a080bf94c48d5da65..c6371ac8aaf3794e8f9eae2eb4a639f52e134bd7 100644 (file)
--- a/basis/ui/tools/operations/operations.factor
+++ b/basis/ui/tools/operations/operations.factor
@@ -81,8 +81,6 @@ IN: ui.tools.operations
     { +listener+ t }
 } define-operation
 
-UNION: definition word method-spec link vocab vocab-link ;
-
 [ definition? ] \ edit H{
     { +keyboard+ T{ key-down f { C+ } "e" } }
     { +listener+ t }

diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor
index 22d6cddfb973c40b46fff7f019ff6acd8e353556..12314505d9acf700c2211d02266f2c46e5266acd 100644 (file)
--- a/basis/unicode/breaks/breaks.factor
+++ b/basis/unicode/breaks/breaks.factor
@@ -60,7 +60,7 @@ SYMBOL: table
 : finish-table ( -- table )
     table get [ [ 1 = ] map ] map ;
 
-: eval-seq ( seq -- seq ) [ dup word? [ execute ] when ] map ;
+: eval-seq ( seq -- seq ) [ ?execute ] map ;
 
 : (set-table) ( class1 class2 val -- )
     [ table get nth ] dip '[ _ or ] change-nth ;

diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor
index 434b133b3f2ad38cc789c43aaf629ac82a0ca0ed..c95c5816ac19c1baa754b6aed779b66b45cc9319 100644 (file)
--- a/core/definitions/definitions.factor
+++ b/core/definitions/definitions.factor
@@ -3,6 +3,8 @@
 USING: kernel sequences namespaces assocs graphs math math.order ;
 IN: definitions
 
+MIXIN: definition
+
 ERROR: no-compilation-unit definition ;
 
 SYMBOLS: inlined-dependency flushed-dependency called-dependency ;

diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 8380a41207a16afa017238cb9ce1bc234bbb4d79..c22641d4391318eb8e28eabd8b877fa9267db2ec 100644 (file)
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2008 Slava Pestov.
+! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors words kernel sequences namespaces make assocs
 hashtables definitions kernel.private classes classes.private
@@ -27,6 +27,8 @@ M: generic definition drop f ;
 PREDICATE: method-spec < pair
     first2 generic? swap class? and ;
 
+INSTANCE: method-spec definition
+
 : order ( generic -- seq )
     "methods" word-prop keys sort-classes ;
 

diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor
index 56f19595cbbabb099b432033a41f26a2165099ee..baccf5605946a10f2c4a4906ec915683e45002e6 100644 (file)
--- a/core/kernel/kernel.factor
+++ b/core/kernel/kernel.factor
@@ -23,6 +23,10 @@ GENERIC: call ( callable -- )
 
 GENERIC: execute ( word -- )
 
+GENERIC: ?execute ( word -- value )
+
+M: object ?execute ;
+
 DEFER: if
 
 : ? ( ? true false -- true/false )

diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor
index 6a7e8116cdd2409718f630f62c8243b2bfcb8d34..e8f699748f08cf0c9f2e79adcb24f06ab1deeed1 100644 (file)
--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@@ -566,8 +566,8 @@ HELP: GENERIC#
 { $description "Defines a new generic word which dispatches on the " { $snippet "n" } "th most element from the top of the stack in the current vocabulary. Initially, it contains no methods, and thus will throw a " { $link no-method } " error when called." }
 { $notes
     "The following two definitions are equivalent:"
-    { $code "GENERIC: foo" }
-    { $code "GENERIC# foo 0" }
+    { $code "GENERIC: foo ( obj -- )" }
+    { $code "GENERIC# foo 0 ( obj -- )" }
 } ;
 
 HELP: MATH:

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index edac418285989cd95b4cd56810dd29e16ab7be4a..2b978e866625c101e51be13c2122119d6d1dd26f 100644 (file)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -108,4 +108,6 @@ SYMBOL: load-vocab-hook ! ( name -- vocab )
 : load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;
 
 PREDICATE: runnable-vocab < vocab
-    vocab-main >boolean ;
\ No newline at end of file
+    vocab-main >boolean ;
+
+INSTANCE: vocab-spec definition
\ No newline at end of file

diff --git a/core/words/words.factor b/core/words/words.factor
index cfdcd4517f2e1e49110fa3197de2d61d262dbcc2..5b230c1b0066c095ca20fce950ed3a029b46b158 100755 (executable)
--- a/core/words/words.factor
+++ b/core/words/words.factor
@@ -12,6 +12,8 @@ IN: words
 
 M: word execute (execute) ;
 
+M: word ?execute execute( -- value ) ;
+
 M: word <=>
     [ [ name>> ] [ vocabulary>> ] bi 2array ] compare ;
 
@@ -260,3 +262,5 @@ M: word hashcode*
 M: word literalize <wrapper> ;
 
 : xref-words ( -- ) all-words [ xref ] each ;
+
+INSTANCE: word definition
\ No newline at end of file