steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
db4
Keith Lazuka 2009-09-08 12:43:47 -04:00
parent 9f9b6bca01
commit 3fb75247b2
15 changed files with 142 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/fonts/fonts.factor
View File

@ -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 ;

4
basis/help/markup/markup.factor
View File

@ -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

20
basis/help/stylesheet/stylesheet.factor
View File

@ -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

13
basis/io/styles/styles-docs.factor
View File

@ -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

1
basis/io/styles/styles.factor
View File

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

33
basis/prettyprint/backend/backend.factor
View File

@ -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
generic hashtables assocs kernel math namespaces make sequences
strings sbufs vectors words prettyprint.config prettyprint.custom
prettyprint.sections quotations io io.pathnames io.styles math.parser
effects classes.tuple math.order classes.tuple.private classes
combinators colors ;
USING: accessors arrays assocs byte-arrays byte-vectors classes
classes.tuple classes.tuple.private colors colors.constants
combinators continuations effects generic hashtables io
io.pathnames io.styles kernel make math math.order math.parser
namespaces prettyprint.config prettyprint.custom
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 ;

34
basis/prettyprint/stylesheet/stylesheet.factor Normal file
View File

@ -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 ;

2
basis/see/see.factor
View File

@ -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

4
basis/ui/gadgets/buttons/buttons-docs.factor
View File

@ -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 } } }

26
basis/ui/gadgets/buttons/buttons.factor
View File

@ -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-enter [ button-update ] }
{ mouse-leave [ button-leave ] }
{ 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-clicked" button-clicked-background COLOR: white <border-button-state-pen> dup dup
"button" button-background button-clicked-background
<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
'[ drop @ ] <border-button> ;
swapd [ command-name swap ] keep command-button-quot
'[ drop @ ] <border-button> swap gesture>tooltip >>tooltip ;
: <toolbar> ( target -- toolbar )
<shelf>

25
basis/ui/gadgets/labels/labels.factor
View File

@ -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*
>label<
[
background get [ font-with-background ] when*
foreground get [ font-with-foreground ] when*
] dip
: draw-text* ( font text fg bg -- )
[ rot ] dip
[ font-with-background ] when* swap
[ font-with-foreground ] when* swap
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 ;

5
basis/ui/gadgets/panes/panes.factor
View File

@ -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 )

18
basis/ui/gadgets/status-bar/status-bar.factor
View File

@ -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
sequences ui.gadgets.labels ui.gadgets.tracks
ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ;
USING: accessors calendar colors colors.constants fonts kernel
models models.arrow models.delay sequences summary ui
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 -- )

7
basis/ui/tools/browser/browser.factor
View File

@ -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 pane>> <scroller> >>scroller
dup scroller>> 1 track-add ;
dup dup <help-pane> { 10 0 } <border> { 1 1 } >>fill
<scroller> >>scroller scroller>> 1 track-add ;
M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ;

6
basis/vocabs/prettyprint/prettyprint.factor
View File

@ -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