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

basis/base64/base64-tests.factor

@@ -1,25 +1,26 @@
-USING: kernel tools.test base64 strings sequences  ;
+USING: kernel tools.test base64 strings sequences
+io.encodings.string io.encodings.ascii ;
 IN: base64.tests
 
-[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" >base64 base64> >string
+[ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" ascii encode >base64 base64> ascii decode
 ] unit-test
-[ "" ] [ "" >base64 base64> >string ] unit-test
+[ f ] [ "" ascii encode >base64 base64> ascii decode ] unit-test
-[ "a" ] [ "a" >base64 base64> >string ] unit-test
+[ "a" ] [ "a" ascii encode >base64 base64> ascii decode ] unit-test
-[ "ab" ] [ "ab" >base64 base64> >string ] unit-test
+[ "ab" ] [ "ab" ascii encode >base64 base64> ascii decode ] unit-test
-[ "abc" ] [ "abc" >base64 base64> >string ] unit-test
+[ "abc" ] [ "abc" ascii encode >base64 base64> ascii decode ] unit-test
-[ "abcde" ] [ "abcde" >base64 3 cut "\r\n" swap 3append base64> >string ] unit-test
+[ "abcde" ] [ "abcde" ascii encode >base64 3 cut "\r\n" swap 3append base64> ascii decode ] unit-test
 
 ! From http://en.wikipedia.org/wiki/Base64
 [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
 [
     "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
-    >base64 >string
+    ascii encode >base64 >string
 ] unit-test
 
 [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
 [
     "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
-    >base64-lines >string
+    ascii encode >base64-lines >string
 ] unit-test
 
 \ >base64 must-infer

basis/base64/base64.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators io io.binary io.encodings.binary
-io.streams.byte-array io.streams.string kernel math namespaces
+io.streams.byte-array kernel math namespaces
 sequences strings io.crlf ;
 IN: base64
 
@@ -75,10 +75,10 @@ PRIVATE>
     } case ;
 
 : >base64 ( seq -- base64 )
-    binary [ [ encode-base64 ] with-string-reader ] with-byte-writer ;
+    binary [ binary [ encode-base64 ] with-byte-reader ] with-byte-writer ;
 
 : base64> ( base64 -- seq )
-    [ binary [ decode-base64 ] with-byte-reader ] with-string-writer ;
+    binary [ binary [ decode-base64 ] with-byte-reader ] with-byte-writer ;
 
 : >base64-lines ( seq -- base64 )
-    binary [ [ encode-base64-lines ] with-string-reader ] with-byte-writer ;
+    binary [ binary [ encode-base64-lines ] with-byte-reader ] with-byte-writer ;

basis/help/html/html.factor

@@ -64,7 +64,6 @@ M: topic url-of topic>filename ;
     tri simple-page ;
           
 : generate-help-file ( topic -- )
-    dup .
     dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
 
 : all-vocabs-really ( -- seq )

basis/tools/annotations/annotations-docs.factor

@@ -44,16 +44,6 @@ HELP: annotate-methods
      { "word" word } { "quot" quotation } }
 { $description "Annotates the word -- for generic words, all its methods -- with the quotation." } ;
 
-HELP: entering
-{ $values
-     { "str" string } }
-{ $description "Prints a message and the inputs to the word before the word has been called." } ;
-
-HELP: leaving
-{ $values
-     { "str" string } }
-{ $description "Prints a message and the outputs from a word after a word has been called." } ;
-
 HELP: reset
 { $values
      { "word" word } }
@@ -65,12 +55,6 @@ HELP: watch-vars
      { "word" word } { "vars" "a sequence of symbols" } }
 { $description "Annotates a word definition to print the " { $snippet "vars" } " upon entering the word. This word is useful for debugging." } ;
 
-HELP: word-inputs
-{ $values
-     { "word" word }
-     { "seq" sequence } }
-{ $description "Makes a sequence of the inputs to a word by counting the number of inputs in the stack effect and saving that many items from the datastack." } ;
-
 HELP: add-timing
 { $values { "word" word } }
 { $description "Adds timing code to a word, which records its total running time, including that of words it calls, on every invocation." }

basis/tools/annotations/annotations-tests.factor

@@ -38,3 +38,11 @@ M: object another-generic ;
 [ ] [ \ another-generic reset ] unit-test
 
 [ "" ] [ [ 3 another-generic drop ] with-string-writer ] unit-test
+
+GENERIC: blah-generic ( a -- b )
+
+M: string blah-generic ;
+
+{ string blah-generic } watch
+
+[ ] [ "hi" blah-generic ] unit-test

basis/tools/annotations/annotations.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel math sorting words parser io summary
 quotations sequences prettyprint continuations effects
@@ -20,16 +20,34 @@ M: word reset
         f "unannotated-def" set-word-prop
     ] [ drop ] if ;
 
+M: method-spec reset
+    first2 method reset ;
+
 ERROR: cannot-annotate-twice word ;
 
+<PRIVATE
+
+: check-annotate-twice ( word -- word )
+    dup "unannotated-def" word-prop [
+        cannot-annotate-twice
+    ] when ;
+
+: method-spec>word ( obj -- word )
+    dup method-spec? [ first2 method ] when ;
+
+: save-unannotated-def ( word -- )
+    dup def>> "unannotated-def" set-word-prop ;
+
+: (annotate) ( word quot -- )
+    [ dup def>> ] dip call define ; inline
+
+PRIVATE>
+
 : annotate ( word quot -- )
-    over "unannotated-def" word-prop [
+    [ method-spec>word check-annotate-twice ] dip
-        over cannot-annotate-twice
+    [ over save-unannotated-def (annotate) ] with-compilation-unit ; inline
-    ] when
+
-    [
+<PRIVATE
-        over dup def>> "unannotated-def" set-word-prop
-        [ dup def>> ] dip call define
-    ] with-compilation-unit ; inline
 
 : word-inputs ( word -- seq )
     stack-effect [
@@ -58,8 +76,12 @@ ERROR: cannot-annotate-twice word ;
 : (watch) ( word def -- def )
     over '[ _ entering @ _ leaving ] ;
 
+PRIVATE>
+
 : watch ( word -- )
-    dup [ (watch) ] annotate ;
+    dup '[ [ _ ] dip (watch) ] annotate ;
+
+<PRIVATE
 
 : (watch-vars) ( word vars quot -- newquot )
    '[
@@ -68,6 +90,8 @@ ERROR: cannot-annotate-twice word ;
         @
     ] ;
 
+PRIVATE>
+
 : watch-vars ( word vars -- )
     dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
 
@@ -79,6 +103,9 @@ M: generic annotate-methods
 M: word annotate-methods
     annotate ;
 
+M: method-spec annotate-methods
+    annotate ;
+
 : breakpoint ( word -- )
     [ add-breakpoint ] annotate-methods ;
 
@@ -92,9 +119,13 @@ word-timing [ H{ } clone ] initialize
 : reset-word-timing ( -- )
     word-timing get clear-assoc ;
 
+<PRIVATE
+
 : (add-timing) ( def word -- def' )
     '[ _ benchmark _ word-timing get at+ ] ;
 
+PRIVATE>
+
 : add-timing ( word -- )
     dup '[ _ (add-timing) ] annotate ;
 

basis/ui/gadgets/panes/panes-tests.factor

@@ -106,3 +106,9 @@ ARTICLE: "test-article-2" "This is a test article"
 [ ] [
     \ = <model> [ see ] <pane-control> [ ] with-grafted-gadget
 ] unit-test
+
+: <test-pane> ( -- foo )
+    <gadget> pane new-pane ;
+
+[ t ] [ <test-pane> dup input>> child? ] unit-test
+[ t ] [ <test-pane> dup last-line>> child? ] unit-test

basis/ui/gadgets/panes/panes.factor

@@ -63,7 +63,9 @@ M: pane gadget-selection ( pane -- string/f )
     selection-color >>selection-color ; inline
 
 : init-last-line ( pane -- pane )
-    horizontal <track> [ >>last-line ] [ 1 track-add ] bi ; inline
+    horizontal <track>
+    [ >>last-line ] [ 1 track-add ] bi
+    dup prepare-last-line ; inline
 
 : new-pane ( input class -- pane )
     [ vertical ] dip new-track

basis/windows/nt/nt.factor

@@ -11,6 +11,5 @@ USING: alien sequences ;
     { "libm"     "msvcrt.dll"   "cdecl"   }
     { "gl"       "opengl32.dll" "stdcall" }
     { "glu"      "glu32.dll"    "stdcall" }
-    { "freetype" "freetype6.dll" "cdecl"  }
     { "ole32"    "ole32.dll"    "stdcall" }
 } [ first3 add-library ] each

core/generic/generic.factor

@@ -83,6 +83,9 @@ TUPLE: check-method class generic ;
 PREDICATE: method-body < word
     "method-generic" word-prop >boolean ;
 
+M: method-spec stack-effect
+    first2 method stack-effect ;
+
 M: method-body stack-effect
     "method-generic" word-prop stack-effect ;