Rename font key in io.styles to font-name for clarity; clean up some nefarious stack shuffling in ui.gadgets.panes

basis/help/stylesheet/stylesheet.factor

@@ -1,11 +1,11 @@
-! Copyright (C) 2005, 2006 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io.styles namespaces colors ;
 IN: help.stylesheet
 
 SYMBOL: default-span-style
 H{
-    { font "sans-serif" }
+    { font-name "sans-serif" }
     { font-size 12 }
     { font-style plain }
 } default-span-style set-global
@@ -29,7 +29,7 @@ H{ { font-style bold } } strong-style set-global
 
 SYMBOL: title-style
 H{
-    { font "sans-serif" }
+    { font-name "sans-serif" }
     { font-size 18 }
     { font-style bold }
     { wrap-margin 500 }
@@ -42,21 +42,21 @@ H{ { font-size 10 } } help-path-style set-global
 
 SYMBOL: heading-style
 H{
-    { font "sans-serif" }
+    { font-name "sans-serif" }
     { font-size 16 }
     { font-style bold }
 } heading-style set-global
 
 SYMBOL: subsection-style
 H{
-    { font "sans-serif" }
+    { font-name "sans-serif" }
     { font-size 14 }
     { font-style bold }
 } subsection-style set-global
 
 SYMBOL: snippet-style
 H{
-    { font "monospace" }
+    { font-name "monospace" }
     { font-size 12 }
     { foreground T{ rgba f 0.1 0.1 0.4 1 } }
 } snippet-style set-global
@@ -73,7 +73,7 @@ H{ { font-style bold } } input-style set-global
 
 SYMBOL: url-style
 H{
-    { font "monospace" }
+    { font-name "monospace" }
     { foreground T{ rgba f 0.0 0.0 1.0 1.0 } }
 } url-style set-global
 

basis/html/streams/streams.factor

@@ -86,7 +86,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
     [
         foreground [ fg-css,    ] apply-style
         background [ bg-css,    ] apply-style
-        font       [ font-css,  ] apply-style
+        font-name  [ font-css,  ] apply-style
         font-style [ style-css, ] apply-style
         font-size  [ size-css,  ] apply-style
     ] make-css ;

basis/io/styles/styles-docs.factor

@@ -115,7 +115,7 @@ ARTICLE: "character-styles" "Character styles"
 "Character styles for " { $link stream-format } " and " { $link with-style } ":"
 { $subsection foreground }
 { $subsection background }
-{ $subsection font }
+{ $subsection font-name }
 { $subsection font-size }
 { $subsection font-style }
 { $subsection presented } ;
@@ -195,11 +195,11 @@ HELP: background
     }
 } ;
 
-HELP: font
+HELP: font-name
 { $description "Character style. Font family named by a string." }
 { $examples
     "This example outputs some different font sizes:"
-    { $code "{ \"monospace\" \"serif\" \"sans-serif\" }\n[ dup font associate format nl ] each" }
+    { $code "{ \"monospace\" \"serif\" \"sans-serif\" }\n[ dup font-name associate format nl ] each" }
 } ;
 
 HELP: font-size

basis/io/styles/styles.factor

@@ -130,7 +130,7 @@ SYMBOL: bold-italic
 ! Character styles
 SYMBOL: foreground
 SYMBOL: background
-SYMBOL: font
+SYMBOL: font-name
 SYMBOL: font-size
 SYMBOL: font-style
 

basis/ui/gadgets/panes/panes.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel namespaces sequences
-io.styles strings quotations math opengl combinators
+io.styles strings quotations math opengl combinators memoize
 math.vectors sorting splitting assocs classes.tuple models
 continuations destructors accessors math.geometry.rect fry
 ui.gadgets ui.gadgets.borders ui.gadgets.buttons
@@ -25,9 +25,9 @@ selection-color caret mark selecting? ;
 : add-current ( pane current -- pane )
     [ >>current ] [ add-gadget ] bi ;
 
-: prepare-line ( pane -- pane )
+: prepare-line ( pane -- )
     clear-selection
-    dup prototype>> clone add-current ;
+    dup prototype>> clone add-current drop ;
 
 : pane-caret&mark ( pane -- caret mark )
     [ caret>> ] [ mark>> ] bi ;
@@ -51,7 +51,7 @@ M: pane gadget-selection ( pane -- string/f )
         { 0 1 } >>orientation
         <shelf> >>prototype
         <incremental> add-output
-        prepare-line
+        dup prepare-line
         selection-color >>selection-color ;
 
 : <pane> ( -- pane ) pane new-pane ;
@@ -77,12 +77,12 @@ M: node draw-selection ( loc node -- )
 
 M: pane draw-gadget*
     dup gadget-selection? [
-        dup selection-color>> gl-color
+        [ selection-color>> gl-color ]
-        origin get over rect-loc v- swap selected-children
+        [
+            [ [ origin get ] dip loc>> v- ] keep selected-children
             [ draw-selection ] with each
-    ] [
+        ] bi
-        drop
+    ] [ drop ] if ;
-    ] if ;
 
 : scroll-pane ( pane -- )
     dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
@@ -100,20 +100,22 @@ C: <pane-stream> pane-stream
 
 : smash-pane ( pane -- gadget ) output>> smash-line ;
 
-: pane-nl ( pane -- pane )
+: pane-nl ( pane -- )
-    dup current>> dup unparent smash-line
+    [
-    over output>> add-incremental
+        [ current>> [ unparent ] [ smash-line ] bi ] [ output>> ] bi
-    prepare-line ;
+        add-incremental
+    ]
+    [ prepare-line ] bi ;
 
-: pane-write ( pane seq -- )
+: pane-write ( seq pane -- )
-    [ pane-nl ]
+    [ '[ _ pane-nl ] ]
-    [ over current>> stream-write ]
+    [ '[ _ current>> stream-write ] ] bi
-    interleave drop ;
+    interleave ;
 
-: pane-format ( style pane seq -- )
+: pane-format ( seq style pane -- )
-    [ pane-nl ]
+    [ '[ _ drop _ pane-nl ] ]
-    [ 2over current>> stream-format ]
+    [ '[ _ _ current>> stream-format ] ] 2bi
-    interleave 2drop ;
+    interleave ;
 
 GENERIC: write-gadget ( gadget stream -- )
 
@@ -157,16 +159,16 @@ M: pane-control model-changed ( model pane-control -- )
     [ pane>> ] dip keep scroll-pane ; inline
 
 M: pane-stream stream-nl
-    [ pane-nl drop ] do-pane-stream ;
+    [ pane-nl ] do-pane-stream ;
 
 M: pane-stream stream-write1
     [ current>> stream-write1 ] do-pane-stream ;
 
 M: pane-stream stream-write
-    [ swap string-lines pane-write ] do-pane-stream ;
+    [ [ string-lines ] dip pane-write ] do-pane-stream ;
 
 M: pane-stream stream-format
-    [ rot string-lines pane-format ] do-pane-stream ;
+    [ [ string-lines ] 2dip pane-format ] do-pane-stream ;
 
 M: pane-stream dispose drop ;
 
@@ -186,12 +188,12 @@ M: pane-stream make-span-stream
 : apply-background-style ( style gadget -- style gadget )
     background [ solid-interior ] apply-style ;
 
-: specified-font ( style -- font )
+MEMO: specified-font ( font style size -- font )
-    <font>
+    #! We memoize here to avoid creating lots of duplicate font objects.
-        swap
+    [ <font> ] 3dip
-        [ font swap at "monospace" or >>name ]
+    [ "monospace" or >>name ]
     [
-            font-style swap at {
+        {
             { f [ ] }
             { plain [ ] }
             { bold [ t >>bold? ] }
@@ -199,11 +201,15 @@ M: pane-stream make-span-stream
             { bold-italic [ t >>bold? t >>italic? ] }
         } case
     ]
-        [ font-size swap at 12 or >>size ]
+    [ 12 or >>size ]
-        tri ;
+    tri* ;
 
 : apply-font-style ( style gadget -- style gadget )
-    over specified-font >>font ;
+    over
+    [ font-name swap at ]
+    [ font-style swap at ]
+    [ font-size swap at ]
+    tri specified-font >>font ;
 
 : apply-presentation-style ( style gadget -- style gadget )
     presented [ <presentation> ] apply-style ;
@@ -331,10 +337,10 @@ M: paragraph stream-format
     presented pick at [
         gadget-format
     ] [
-        rot " " split
+        [ " " split ] 2dip
-        [ 2dup gadget-bl ]
+        [ '[ _ _ gadget-bl ] ]
-        [ 2over gadget-format ] interleave
+        [ '[ _ _ gadget-format ] ] 2bi
-        2drop
+        interleave
     ] if ;
 
 : caret>mark ( pane -- pane )