help.markup: added $subsections markup and consolidated $link implementations

- Created a new markup element, $subsections, which is a plural variant
     of $subsection. The advantage is that it automatically inserts a
     blank line after the final subsection which makes help articles
     considerably easier to read.
- Consolidated the implementation of $link, $long-link and $pretty-link
- Moved $definition-icons from definition.icons to help.markup
- Moved $pretty-link from help.vocabs to help.markup
db4
Keith Lazuka 2009-09-21 15:35:16 -04:00
parent 992a49839f
commit 66a6108d42
4 changed files with 72 additions and 51 deletions

View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: assocs classes.predicate fry generic io.pathnames kernel USING: assocs classes.predicate fry generic help.topics
macros sequences vocabs words words.symbol words.constant io.pathnames kernel lexer macros namespaces parser sequences
lexer parser help.topics help.markup namespaces sorting ; vocabs words words.constant words.symbol ;
IN: definitions.icons IN: definitions.icons
GENERIC: definition-icon ( definition -- path ) GENERIC: definition-icon ( definition -- path )
@ -41,10 +41,3 @@ ICON: topic help-article
ICON: runnable-vocab runnable-vocab ICON: runnable-vocab runnable-vocab
ICON: vocab open-vocab ICON: vocab open-vocab
ICON: vocab-link unopen-vocab ICON: vocab-link unopen-vocab
: $definition-icons ( element -- )
drop
icons get >alist sort-keys
[ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
{ "" "Definition class" } prefix
$table ;

View File

@ -10,7 +10,7 @@ IN: help.crossref
collect-elements [ >link ] map ; collect-elements [ >link ] map ;
: article-children ( topic -- seq ) : article-children ( topic -- seq )
{ $subsection } article-links ; { $subsection $subsections } article-links ;
: help-path ( topic -- seq ) : help-path ( topic -- seq )
[ article-parent ] follow rest ; [ article-parent ] follow rest ;

View File

@ -1,10 +1,11 @@
! Copyright (C) 2005, 2009 Slava Pestov. ! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions generic io kernel assocs USING: accessors arrays assocs classes colors.constants
hashtables namespaces make parser prettyprint sequences strings combinators definitions definitions.icons effects fry generic
io.styles vectors words math sorting splitting classes slots fry hashtables help.stylesheet help.topics io io.styles kernel make
sets vocabs help.stylesheet help.topics vocabs.loader quotations math namespaces parser present prettyprint
combinators see present ; prettyprint.stylesheet quotations see sequences sets slots
sorting splitting strings vectors vocabs vocabs.loader words ;
FROM: prettyprint.sections => with-pprint ; FROM: prettyprint.sections => with-pprint ;
IN: help.markup IN: help.markup
@ -156,45 +157,73 @@ ALIAS: $slot $snippet
: write-link ( string object -- ) : write-link ( string object -- )
link-style get [ write-object ] with-style ; link-style get [ write-object ] with-style ;
: ($link) ( article -- ) : link-icon ( topic -- )
[ [ article-name ] [ >link ] bi write-link ] ($span) ; definition-icon 1array $image ;
: $link ( element -- ) : link-text ( topic -- )
first ($link) ;
: ($definition-link) ( word -- )
[ article-name ] keep write-link ; [ article-name ] keep write-link ;
: $definition-link ( element -- ) : link-effect ( topic -- )
first ($definition-link) ; dup word? [
stack-effect [ effect>string ] [ effect-style ] bi
[ write ] with-style
] [ drop ] if ;
: ($long-link) ( object -- ) : inter-cleave ( x seq between -- )
[ article-title ] [ >link ] bi write-link ; [ [ call( x -- ) ] with ] dip swap interleave ; inline
: $long-link ( object -- ) : (($link)) ( topic words -- )
first ($long-link) ; [ dup topic? [ >link ] unless ] dip
[ [ bl ] inter-cleave ] ($span) ; inline
: ($link) ( topic -- )
{ [ link-text ] } (($link)) ;
: $link ( element -- ) first ($link) ;
: ($long-link) ( topic -- )
{ [ link-text ] [ link-effect ] } (($link)) ;
: $long-link ( element -- ) first ($long-link) ;
: ($pretty-link) ( topic -- )
{ [ link-icon ] [ link-text ] } (($link)) ;
: $pretty-link ( element -- ) first ($pretty-link) ;
: ($long-pretty-link) ( topic -- )
{ [ link-icon ] [ link-text ] [ link-effect ] } (($link)) ;
: $long-pretty-link ( element -- ) first ($long-pretty-link) ;
: <$pretty-link> ( definition -- element )
1array \ $pretty-link prefix ;
: ($subsection) ( element quot -- ) : ($subsection) ( element quot -- )
[ [
subsection-style get [ subsection-style get [ call ] with-style
bullet get write bl
call
] with-style
] ($block) ; inline ] ($block) ; inline
: $subsection* ( topic -- )
[
[ ($long-pretty-link) ] with-scope
] ($subsection) ;
: $subsections ( children -- )
[ $subsection* ] each nl ;
: $subsection ( element -- ) : $subsection ( element -- )
[ first ($long-link) ] ($subsection) ; first $subsection* ;
: ($vocab-link) ( text vocab -- ) : ($vocab-link) ( text vocab -- )
>vocab-link write-link ; >vocab-link write-link ;
: $vocab-subsection ( element -- ) : $vocab-subsection ( element -- )
[ [
first2 dup vocab-help dup [ first2 dup vocab-help
2nip ($long-link) [ 2nip ($long-pretty-link) ]
] [ [ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ]
drop ($vocab-link) if*
] if
] ($subsection) ; ] ($subsection) ;
: $vocab-link ( element -- ) : $vocab-link ( element -- )
@ -390,3 +419,10 @@ M: array elements*
: <$snippet> ( str -- element ) : <$snippet> ( str -- element )
1array \ $snippet prefix ; 1array \ $snippet prefix ;
: $definition-icons ( element -- )
drop
icons get >alist sort-keys
[ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
{ "" "Definition class" } prefix
$table ;

View File

@ -3,25 +3,17 @@
USING: accessors arrays assocs classes classes.builtin USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple classes.union combinators classes.singleton classes.tuple classes.union combinators
definitions effects fry generic help help.markup help.stylesheet effects fry generic help help.markup help.stylesheet
help.topics io io.files io.pathnames io.styles kernel macros help.topics io io.pathnames io.styles kernel macros make
make namespaces prettyprint sequences sets sorting summary namespaces sequences sorting summary vocabs vocabs.files
vocabs vocabs.files vocabs.hierarchy vocabs.loader vocabs.hierarchy vocabs.loader vocabs.metadata words
vocabs.metadata words words.symbol definitions.icons ; words.symbol ;
FROM: vocabs.hierarchy => child-vocabs ; FROM: vocabs.hierarchy => child-vocabs ;
IN: help.vocabs IN: help.vocabs
: about ( vocab -- ) : about ( vocab -- )
[ require ] [ vocab help ] bi ; [ require ] [ vocab help ] bi ;
: $pretty-link ( element -- )
[ first definition-icon 1array $image " " print-element ]
[ $definition-link ]
bi ;
: <$pretty-link> ( definition -- element )
1array \ $pretty-link prefix ;
: vocab-row ( vocab -- row ) : vocab-row ( vocab -- row )
[ <$pretty-link> ] [ vocab-summary ] bi 2array ; [ <$pretty-link> ] [ vocab-summary ] bi 2array ;