Fixing code for first-class fonts

basis/io/styles/styles.factor

@@ -3,7 +3,7 @@
 USING: hashtables io io.streams.plain io.streams.string
 colors summary make accessors splitting math.order
 kernel namespaces assocs destructors strings sequences
-present fry ;
+present fry strings.tables ;
 IN: io.styles
 
 GENERIC: stream-format ( str style stream -- )
@@ -116,19 +116,6 @@ M: plain-writer make-span-stream
 M: plain-writer make-block-stream
     nip <ignore-close-stream> ;
 
-: format-column ( seq ? -- seq )
-    [
-        dup [ length ] map supremum
-        '[ _ CHAR: \s pad-right ] map
-    ] unless ;
-
-: map-last ( seq quot -- seq )
-    [ dup length <reversed> ] dip '[ 0 = @ ] 2map ; inline
-
-: format-table ( table -- seq )
-    flip [ format-column ] map-last
-    flip [ " " join ] map ;
-
 M: plain-writer stream-write-table
     [ drop format-table [ print ] each ] with-output-stream* ;
 

basis/strings/tables/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/strings/tables/tables-tests.factor

@@ -1,4 +1,4 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test ui.text.core-text ;
+USING: tools.test strings.tables ;
-IN: ui.text.core-text.tests
+IN: strings.tables.tests

basis/strings/tables/tables.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences fry ;
+IN: strings.tables
+
+<PRIVATE
+
+: format-column ( seq ? -- seq )
+    [
+        dup [ length ] map supremum
+        '[ _ CHAR: \s pad-right ] map
+    ] unless ;
+
+: map-last ( seq quot -- seq )
+    [ dup length <reversed> ] dip '[ 0 = @ ] 2map ; inline
+
+PRIVATE>
+
+: format-table ( table -- seq )
+    flip [ format-column ] map-last
+    flip [ " " join ] map ;

basis/ui/gadgets/editors/editors-docs.factor

@@ -1,5 +1,6 @@
 USING: documents help.markup help.syntax ui.gadgets
-ui.gadgets.scrollers models strings ui.commands ;
+ui.gadgets.scrollers models strings ui.commands
+ui.text colors ;
 IN: ui.gadgets.editors
 
 HELP: editor
@@ -9,8 +10,8 @@ $nl
 { $list
     { { $snippet "font" } " - a " { $link font } "." }
     { { $snippet "color" } " - a " { $link color } "." }
-    { { $snippet "caret-color" } " - a " { $link color } ". }
+    { { $snippet "caret-color" } " - a " { $link color } "." }
-    { { $snippet "selection-color" } " - a " { $link color } ". }
+    { { $snippet "selection-color" } " - a " { $link color } "." }
     { { $snippet "caret" } " - a " { $link model } " storing a line/column pair." }
     { { $snippet "mark" } " - a " { $link model } " storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
     { { $snippet "focused?" } " - a boolean." }

basis/ui/gadgets/grids/grids.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces make sequences words io
-math.vectors ui.gadgets columns accessors
+math.vectors ui.gadgets columns accessors strings.tables
 math.geometry.rect locals fry ;
 IN: ui.gadgets.grids
 

basis/ui/gadgets/panes/panes.factor

@@ -1,15 +1,15 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+USING: arrays hashtables io kernel namespaces sequences
+io.styles strings quotations math opengl combinators
+math.vectors sorting splitting assocs classes.tuple models
+continuations destructors accessors math.geometry.rect fry
+ui.gadgets ui.gadgets.borders ui.gadgets.buttons
 ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
 ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
-hashtables io kernel namespaces sequences io.styles strings
+ui.text ui.gadgets.presentations ui.gadgets.grids
-quotations math opengl combinators math.vectors sorting
+ui.gadgets.grid-lines ;
-splitting assocs ui.gadgets.presentations
-ui.gadgets.grids ui.gadgets.grid-lines
-classes.tuple models continuations destructors accessors
-math.geometry.rect fry ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack
@@ -192,10 +192,11 @@ M: pane-stream make-span-stream
         [ font swap at "monospace" or >>name ]
         [
             font-style swap at {
+                { f [ ] }
                 { plain [ ] }
-                { bold [ t >>bold ] }
+                { bold [ t >>bold? ] }
-                { italic [ t >>italic ] }
+                { italic [ t >>italic? ] }
-                { bold-italic [ t >>bold t >>italic ] }
+                { bold-italic [ t >>bold? t >>italic? ] }
             } case
         ]
         [ font-size swap at 12 or >>size ]

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

@@ -1,6 +1,4 @@
 IN: ui.gadgets.slots.tests
 USING: assocs ui.gadgets.slots tools.test refs ;
 
-\ <editable-slot> must-infer
+[ t ] [ [ ] [ ] { 1 2 3 } 2 <value-ref> <slot-editor> slot-editor? ] unit-test
-
-[ t ] [ { 1 2 3 } 2 <value-ref> <slot-editor> slot-editor? ] unit-test

basis/ui/operations/operations-docs.factor

@@ -5,7 +5,7 @@ IN: ui.operations
 
 : $operations ( element -- )
     >quotation call
-    f f operations>commands
+    f operations>commands
     command-map. ;
 
 : $operation ( element -- )

basis/ui/operations/operations-tests.factor

@@ -5,7 +5,7 @@ io.streams.string math help help.markup accessors ;
 
 : my-pprint pprint ;
 
-[ drop t ] \ my-pprint [ ] [ ] f operation boa "op" set
+[ drop t ] \ my-pprint [ ] f operation boa "op" set
 
 [ [ 3 my-pprint ] ] [
     3 "op" get command>> command-quot
@@ -13,7 +13,7 @@ io.streams.string math help help.markup accessors ;
 
 [ "3" ] [ [ 3 "op" get invoke-command ] with-string-writer ] unit-test
 
-[ drop t ] \ my-pprint [ ] [ editor-string ] f operation boa
+[ drop t ] \ my-pprint [ editor-string ] f operation boa
 "op" set
 
 [ "\"4\"" ] [

basis/ui/text/core-text/core-text.factor

@@ -24,8 +24,8 @@ CONSTANT: font-names
 
 : font-traits ( font -- n )
     [ 0 ] dip
-    [ bold>> [ (bold) ] when ]
+    [ bold?>> [ (bold) ] when ]
-    [ italic>> [ (italic) ] when ] bi ;
+    [ italic?>> [ (italic) ] when ] bi ;
 
 : apply-font-traits ( font style -- font' )
     [ drop ] [ [ 0.0 f ] dip font-traits dup ] 2bi

basis/ui/text/text.factor

@@ -5,6 +5,8 @@ IN: ui.text
 
 TUPLE: font name size bold? italic? ;
 
+: <font> ( -- font ) font new ; inline
+
 <PRIVATE
 
 SYMBOL: font-renderer

basis/ui/tools/listener/completion/completion-tests.factor

@@ -2,3 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test ui.tools.listener.completion ;
 IN: ui.tools.listener.completion.tests
+
+[ t ] [ { "USING:" "A" "B" "C" } complete-USING:? ] unit-test
+
+[ f ] [ { "USING:" "A" "B" "C" ";" } complete-USING:? ] unit-test
+
+[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-USING:? ] unit-test

basis/ui/tools/listener/history/history.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors documents kernel math math.order
-sequences fry ;
+sequences fry io.styles ;
 IN: ui.tools.listener.history
 
 TUPLE: history document elements index ;

basis/ui/tools/listener/listener-tests.factor

@@ -96,13 +96,6 @@ IN: ui.tools.listener.tests
 [ ] [ <listener-gadget> "listener" set ] unit-test
 
 "listener" get [
-    [ "dup" ] [
-        \ dup word-completion-string
-    ] unit-test
-
-    [ "equal?" ]
-    [ \ array \ equal? method word-completion-string ] unit-test
-
     <pane> <interactor> "i" set
 
     [ t ] [ "i" get interactor? ] unit-test
@@ -149,10 +142,4 @@ IN: ui.tools.listener.tests
     <gadget> "l" get show-popup
     <gadget> "l" get show-popup
     "l" get hide-popup
-] unit-test
+] unit-test
-
-[ t ] [ { "USING:" "A" "B" "C" } complete-USING:? ] unit-test
-
-[ f ] [ { "USING:" "A" "B" "C" ";" } complete-USING:? ] unit-test
-
-[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-USING:? ] unit-test

basis/ui/ui-docs.factor

@@ -1,7 +1,7 @@
 USING: help.markup help.syntax strings quotations debugger
 namespaces ui.backend ui.gadgets ui.gadgets.worlds
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
-math.geometry.rect colors ;
+math.geometry.rect colors ui.text ;
 IN: ui
 
 HELP: windows
@@ -68,7 +68,7 @@ ARTICLE: "ui-glossary" "UI glossary"
 { $table
     { "color" { "an instance of " { $link color } } }
     { "dimension" "a pair of integers denoting pixel size on screen" }
-    { "font" { "an instance of " { link font } } }
+    { "font" { "an instance of " { $link font } } }
     { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) inherit from " { $link gadget } "." } }
     { "label specifier" { "a string, " { $link f } " or a gadget. See " { $link "ui.gadgets.buttons" } } }
     { "orientation specifier" { "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ", with the former denoting vertical orientation and the latter denoting horizontal. Using a vector instead of symbolic constants allows these values to be directly useful in co-ordinate calculations" } }