Applied ui-tweaks patchset.

- prettyprinter now does syntax highlighting of Factor code
- added a prettyprinter.stylesheet vocab
- text shadow character style for formatted streams
- text shadow for labels
- toolbar buttons display keyboard shortcut in status bar rather than in the button title
- changed some colors in help.stylesheet to match the colors in Factor's scrollbars and border-buttons
- changed status bar color to match the dark blue in Factor's scrollbars
- added some internal padding to the browser gadget to give the article content some breathing room

NOTE: I removed the "pane" slot from browser-gadget. The slot was never used (at least in my image), and now that the browser-gadget's help-pane is wrapped by a "border" gadget, the slot name would be misleading.

basis/fonts/fonts.factor

@@ -9,7 +9,8 @@ size
 bold?
 italic?
 { foreground initial: COLOR: black }
-{ background initial: COLOR: white } ;
+{ background initial: COLOR: white }
+shadow ;
 
 : <font> ( -- font )
     font new ; inline
@@ -37,6 +38,7 @@ italic?
             [ [ italic?>> ] either? >>italic? ]
             [ [ foreground>> ] either? >>foreground ]
             [ [ background>> ] either? >>background ]
+            [ [ shadow>> ] either? >>shadow ]
         } 2cleave
     ] when* ;
 
@@ -56,7 +58,7 @@ italic?
         12 >>size ;
 
 : strip-font-colors ( font -- font' )
-    clone f >>background f >>foreground ;
+    clone f >>background f >>foreground f >>shadow ;
 
 TUPLE: metrics width ascent descent height leading cap-height x-height ;
 

basis/help/markup/markup.factor

@@ -87,7 +87,7 @@ ALIAS: $slot $snippet
 
 : ($code) ( presentation quot -- )
     [
-        snippet-style get [
+        code-char-style get [
             last-element off
             [ ($code-style) ] dip with-nesting
         ] with-style
@@ -307,7 +307,7 @@ M: f ($instance)
 
 : ($see) ( word quot -- )
     [
-        snippet-style get [
+        code-char-style get [
             code-style get swap with-nesting
         ] with-style
     ] ($block) ; inline

basis/help/stylesheet/stylesheet.factor

@@ -17,7 +17,7 @@ H{
 
 SYMBOL: link-style
 H{
-    { foreground COLOR: dark-blue }
+    { foreground COLOR: DodgerBlue4 }
     { font-style bold }
 } link-style set-global
 
@@ -33,12 +33,14 @@ H{
     { font-size 18 }
     { font-style bold }
     { wrap-margin 500 }
-    { page-color COLOR: light-gray }
+    { foreground T{ rgba f 0.216 0.243 0.282 1.0 } }
+    { shadow COLOR: white }
+    { page-color T{ rgba f 0.94 0.94 0.91 1.0 } }
     { border-width 5 }
 } title-style set-global
 
 SYMBOL: help-path-style
-H{ { font-size 10 } } help-path-style set-global
+H{ { font-size 10 } { shadow f } } help-path-style set-global
 
 SYMBOL: heading-style
 H{
@@ -58,12 +60,18 @@ SYMBOL: snippet-style
 H{
     { font-name "monospace" }
     { font-size 12 }
-    { foreground COLOR: navy-blue }
+    { foreground COLOR: DarkOrange4 }
 } snippet-style set-global
 
+SYMBOL: code-char-style
+H{
+    { font-name "monospace" }
+    { font-size 12 }
+} code-char-style set-global
+
 SYMBOL: code-style
 H{
-    { page-color COLOR: gray80 }
+    { page-color T{ rgba f 0.94 0.94 0.91 1.0 } }
     { border-width 5 }
     { wrap-margin f }
 } code-style set-global
@@ -101,7 +109,7 @@ H{
 SYMBOL: table-style
 H{
     { table-gap { 5 5 } }
-    { table-border COLOR: light-gray }
+    { table-border T{ rgba f 0.94 0.94 0.91 1.0 } }
 } table-style set-global
 
 SYMBOL: list-style

basis/io/styles/styles-docs.factor

@@ -121,6 +121,7 @@ ARTICLE: "character-styles" "Character styles"
 "Character styles for " { $link stream-format } " and " { $link with-style } ":"
 { $subsection foreground }
 { $subsection background }
+{ $subsection shadow }
 { $subsection font-name }
 { $subsection font-size }
 { $subsection font-style }
@@ -205,6 +206,18 @@ HELP: background
     }
 } ;
 
+HELP: shadow
+{ $description "Character style. An instance of " { $link color } ". See " { $link "colors" } "." }
+{ $examples
+    { $code
+        "\"Hello world\\n\""
+        "H{ { background COLOR: gray }"
+        "   { shadow COLOR: white }"
+        "   { font-size 72 }"
+        "} format"
+    }
+} ;
+
 HELP: font-name
 { $description "Character style. Font family named by a string." }
 { $examples

basis/io/styles/styles.factor

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

basis/prettyprint/backend/backend.factor

@@ -1,11 +1,12 @@
 ! Copyright (C) 2003, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays byte-vectors continuations
+USING: accessors arrays assocs byte-arrays byte-vectors classes
-generic hashtables assocs kernel math namespaces make sequences
+classes.tuple classes.tuple.private colors colors.constants
-strings sbufs vectors words prettyprint.config prettyprint.custom
+combinators continuations effects generic hashtables io
-prettyprint.sections quotations io io.pathnames io.styles math.parser
+io.pathnames io.styles kernel make math math.order math.parser
-effects classes.tuple math.order classes.tuple.private classes
+namespaces prettyprint.config prettyprint.custom
-combinators colors ;
+prettyprint.sections prettyprint.stylesheet quotations sbufs
+sequences strings vectors words words.symbol ;
 IN: prettyprint.backend
 
 M: effect pprint* effect>string "(" ")" surround text ;
@@ -20,17 +21,6 @@ M: effect pprint* effect>string "(" ")" surround text ;
     ?effect-height 0 < [ end-group ] when ;
 
 ! Atoms
-: word-style ( word -- style )
-    dup "word-style" word-prop >hashtable [
-        [
-            [ presented set ]
-            [
-                [ parsing-word? ] [ delimiter? ] [ t eq? ] tri or or
-                [ bold font-style set ] when
-            ] bi
-        ] bind
-    ] keep ;
-
 : word-name* ( word -- str )
     name>> "( no name )" or ;
 
@@ -59,6 +49,9 @@ M: real pprint* number>string text ;
 
 M: f pprint* drop \ f pprint-word ;
 
+: pprint-effect ( effect -- )
+    [ effect>string ] [ effect-style ] bi styled-text ;
+
 ! Strings
 : ch>ascii-escape ( ch -- str )
     H{
@@ -82,12 +75,6 @@ M: f pprint* drop \ f pprint-word ;
         ] when
     ] when ;
 
-: string-style ( obj -- hash )
-    [
-        presented set
-        T{ rgba f 0.3 0.3 0.3 1.0 } foreground set
-    ] H{ } make-assoc ;
-
 : unparse-string ( str prefix suffix -- str )
     [ [ % do-string-limit [ unparse-ch ] each ] dip % ] "" make ;
 

basis/prettyprint/stylesheet/stylesheet.factor

@@ -0,0 +1,34 @@
+! Copyright (C) 2009 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: colors.constants hashtables io.styles kernel namespaces
+words words.symbol ;
+IN: prettyprint.stylesheet
+
+: word-style ( word -- style )
+    dup "word-style" word-prop >hashtable [
+        [
+            [ presented set ] [
+                [ parsing-word? ] [ delimiter? ] [ symbol? ] tri
+                or or [ COLOR: DarkSlateGray ] [ COLOR: black ] if
+                foreground set
+            ] bi
+        ] bind
+    ] keep ;
+
+: string-style ( obj -- style )
+    [
+        presented set
+        COLOR: LightSalmon4 foreground set
+    ] H{ } make-assoc ;
+
+: vocab-style ( vocab -- style )
+    [
+        presented set
+        COLOR: cornsilk4 foreground set
+    ] H{ } make-assoc ;
+
+: effect-style ( effect -- style )
+    [
+        presented set
+        COLOR: DarkGreen foreground set
+    ] H{ } make-assoc ;

basis/see/see.factor

@@ -39,7 +39,7 @@ M: word print-stack-effect? drop t ;
 
 : stack-effect. ( word -- )
     [ print-stack-effect? ] [ stack-effect ] bi and
-    [ effect>string comment. ] when* ;
+    [ pprint-effect ] when* ;
 
 <PRIVATE
 

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

@@ -7,7 +7,9 @@ HELP: button
 $nl
 "A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-pen } "."
 $nl
-"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked." } ;
+"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked."
+$nl
+"A button can optionally display a message in the window's status bar whenever the mouse cursor hovers over the button. To enable this behavior, just set a string to the button's " { $snippet "tooltip" } " slot." } ;
 
 HELP: <button>
 { $values { "label" gadget } { "quot" { $quotation "( button -- )" } } { "button" "a new " { $link button } } }

basis/ui/gadgets/buttons/buttons.factor

@@ -10,7 +10,7 @@ combinators.smart ;
 FROM: models => change-model ;
 IN: ui.gadgets.buttons
 
-TUPLE: button < border pressed? selected? quot ;
+TUPLE: button < border pressed? selected? quot tooltip ;
 
 <PRIVATE
 
@@ -35,6 +35,12 @@ PRIVATE>
     >>pressed?
     relayout-1 ;
 
+: button-enter ( button -- )
+    dup dup tooltip>> [ swap show-status ] [ drop ] if* button-update ;
+
+: button-leave ( button -- )
+    dup "" swap show-status button-update ;
+
 : button-clicked ( button -- )
     dup button-update
     dup button-rollover?
@@ -43,8 +49,8 @@ PRIVATE>
 button H{
     { T{ button-up } [ button-clicked ] }
     { T{ button-down } [ button-update ] }
-    { mouse-leave [ button-update ] }
+    { mouse-leave [ button-leave ] }
-    { mouse-enter [ button-update ] }
+    { mouse-enter [ button-enter ] }
 } set-gestures
 
 : new-button ( label quot class -- button )
@@ -132,11 +138,14 @@ CONSTANT: button-clicked-background
     }
     
 : <border-button-pen> ( -- pen )
-    "button" button-background COLOR: black <border-button-state-pen> dup
+    "button" button-background button-clicked-background
-    "button-clicked" button-clicked-background COLOR: white <border-button-state-pen> dup dup
+    <border-button-state-pen> dup
+    "button-clicked" button-clicked-background COLOR: white
+    <border-button-state-pen> dup dup
     <button-pen> ;
 
 : border-button-theme ( gadget -- gadget )
+    dup children>> first font>> t >>bold? drop
     horizontal >>orientation
     <border-button-pen> >>interior
     dup dup interior>> pen-pref-dim >>min-dim
@@ -235,9 +244,12 @@ PRIVATE>
 : command-button-quot ( target command -- quot )
     '[ _ _ invoke-command ] ;
 
+: gesture>tooltip ( gesture -- str )
+    [ gesture>string "Shortcut: " prepend ] [ "Shortcut Unassigned" ] if* ;
+
 : <command-button> ( target gesture command -- button )
-    [ command-string swap ] keep command-button-quot
+    swapd [ command-name swap ] keep command-button-quot
-    '[ drop @ ] <border-button> ;
+    '[ drop @ ] <border-button> swap gesture>tooltip >>tooltip ;
 
 : <toolbar> ( target -- toolbar )
     <shelf>

basis/ui/gadgets/labels/labels.factor

@@ -4,7 +4,7 @@ USING: accessors arrays hashtables io kernel math math.functions
 namespaces make opengl sequences strings splitting ui.gadgets
 ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
 ui.baseline-alignment ui.text colors colors.constants models
-combinators ;
+combinators opengl.gl ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -65,14 +65,25 @@ M: label baseline
 M: label cap-height
     label-metrics cap-height>> round ;
 
-M: label draw-gadget*
+: draw-text* ( font text fg bg -- )
-    >label<
+    [ rot ] dip
-    [
+    [ font-with-background ] when* swap
-        background get [ font-with-background ] when*
+    [ font-with-foreground ] when* swap
-        foreground get [ font-with-foreground ] when*
-    ] dip
     draw-text ;
 
+: draw-shadowed-text ( font text -- )
+    [
+        { 0 1 } [ over shadow>> background get draw-text* ]
+        with-translation
+    ] [ foreground get transparent draw-text* ] 2bi ;
+
+: draw-normal-text ( font text -- )
+    foreground get background get draw-text* ;
+
+M: label draw-gadget*
+    >label< over shadow>>
+    [ draw-shadowed-text ] [ draw-normal-text ] if ;
+
 M: label gadget-text* string>> % ;
 
 TUPLE: label-control < label ;

basis/ui/gadgets/panes/panes.factor

@@ -11,7 +11,7 @@ ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
 ui.text ui.gadgets.presentations ui.gadgets.grids ui.gadgets.tracks
 ui.gadgets.icons ui.gadgets.grid-lines ui.baseline-alignment
 colors io.styles ;
-FROM: io.styles => foreground background ;
+FROM: io.styles => foreground background shadow ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < track
@@ -199,11 +199,12 @@ MEMO: specified-font ( assoc -- font )
         [ font-size swap at >>size ]
         [ foreground swap at >>foreground ]
         [ background swap at >>background ]
+        [ shadow swap at >>shadow ]
     } cleave
     derive-font ;
 
 : apply-font-style ( style gadget -- style gadget )
-    { font-name font-style font-size foreground background }
+    { font-name font-style font-size foreground background shadow }
     pick extract-keys specified-font >>font ;
 
 : apply-style ( style gadget key quot -- style gadget )

basis/ui/gadgets/status-bar/status-bar.factor

@@ -1,13 +1,23 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models models.delay models.arrow
+USING: accessors calendar colors colors.constants fonts kernel
-sequences ui.gadgets.labels ui.gadgets.tracks
+models models.arrow models.delay sequences summary ui
-ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ;
+ui.gadgets ui.gadgets.labels ui.gadgets.tracks
+ui.gadgets.worlds ui.pens.solid ui.private ;
 IN: ui.gadgets.status-bar
 
+: status-bar-font ( -- font )
+    sans-serif-font clone
+    T{ rgba f 0.216 0.243 0.282 1.0 } >>background
+    COLOR: white >>foreground ;
+
+: status-bar-theme ( label -- label )
+    status-bar-font >>font
+    T{ rgba f 0.216 0.243 0.282 1.0 } <solid> >>interior ;
+
 : <status-bar> ( model -- gadget )
     1/10 seconds <delay> [ "" like ] <arrow> <label-control>
-    reverse-video-theme
+    status-bar-theme
     t >>root? ;
 
 : open-status-window ( gadget title/attributes -- )

basis/ui/tools/browser/browser.factor

@@ -11,7 +11,7 @@ ui.gadgets.viewports ui.tools.common ui.tools.browser.popups
 ui.tools.browser.history ;
 IN: ui.tools.browser
 
-TUPLE: browser-gadget < tool history pane scroller search-field popup ;
+TUPLE: browser-gadget < tool history scroller search-field popup ;
 
 { 650 400 } browser-gadget set-tool-dim
 
@@ -59,9 +59,8 @@ M: browser-gadget set-history-value
         dup <history> >>history
         dup <search-field> >>search-field
         dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
-        dup <help-pane> >>pane
+        dup dup <help-pane> { 10 0 } <border> { 1 1 } >>fill
-        dup pane>> <scroller> >>scroller
+        <scroller> >>scroller scroller>> 1 track-add ;
-        dup scroller>> 1 track-add ;
 
 M: browser-gadget graft*
     [ add-definition-observer ] [ call-next-method ] bi ;

basis/vocabs/prettyprint/prettyprint.factor

@@ -2,11 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sorting sequences vocabs io io.styles arrays assocs
 namespaces sets parser colors prettyprint.backend prettyprint.sections
-vocabs.parser make fry math.order ;
+prettyprint.stylesheet vocabs.parser make fry math.order ;
 IN: vocabs.prettyprint
 
 : pprint-vocab ( vocab -- )
-    [ vocab-name ] [ vocab ] bi present-text ;
+    [ vocab-name ] [ vocab vocab-style ] bi styled-text ;
 
 : pprint-in ( vocab -- )
     [ \ IN: pprint-word pprint-vocab ] with-pprint ;
@@ -85,7 +85,7 @@ PRIVATE>
         "To avoid doing this in the future, add the following forms" print
         "at the top of the source file:" print nl
     ] with-style
-    { { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } }
+    { { page-color T{ rgba f 0.94 0.94 0.91 1.0 } } }
     [ manifest get pprint-manifest ] with-nesting
     nl nl
 ] print-use-hook set-global