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

help.markup: check the number of arguments to help markup.

db4
John Benediktsson 2012-07-22 14:05:30 -07:00
parent 0fc94f90c7
commit 9e1f82add6
1 changed files with 27 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,8 +5,8 @@ combinators combinators.smart compiler.units definitions
definitions.icons effects fry generic hashtables help.stylesheet definitions.icons effects fry generic hashtables help.stylesheet
help.topics io io.styles kernel locals make math namespaces help.topics io io.styles kernel locals make math namespaces
parser present prettyprint prettyprint.stylesheet quotations parser present prettyprint prettyprint.stylesheet quotations
see sequences sets slots sorting splitting strings urls vectors see sequences sequences.private sets slots sorting splitting
vocabs vocabs.loader words words.symbol ; strings urls vectors vocabs vocabs.loader words words.symbol ;
FROM: prettyprint.sections => with-pprint ; FROM: prettyprint.sections => with-pprint ;
FROM: namespaces => set ; FROM: namespaces => set ;
IN: help.markup IN: help.markup
@ -206,17 +206,30 @@ M: word link-long-text
: topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline : topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline
ERROR: number-of-arguments found required ;
: check-first ( seq -- first )
dup length 1 = [ length 1 number-of-arguments ] unless
first-unsafe ;
: check-first2 ( seq -- first second )
dup length 2 = [ length 2 number-of-arguments ] unless
first2-unsafe ;
PRIVATE> PRIVATE>
: ($link) ( topic -- ) [ link-text ] topic-span ; : ($link) ( topic -- ) [ link-text ] topic-span ;
: $link ( element -- ) first ($link) ;
: $link ( element -- ) check-first ($link) ;
: ($long-link) ( topic -- ) [ link-long-text ] topic-span ; : ($long-link) ( topic -- ) [ link-long-text ] topic-span ;
: $long-link ( element -- ) first ($long-link) ;
: $long-link ( element -- ) check-first ($long-link) ;
: ($pretty-link) ( topic -- ) : ($pretty-link) ( topic -- )
[ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ; [ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ;
: $pretty-link ( element -- ) first ($pretty-link) ;
: $pretty-link ( element -- ) check-first ($pretty-link) ;
: ($long-pretty-link) ( topic -- ) : ($long-pretty-link) ( topic -- )
[ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ; [ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ;
@ -238,24 +251,24 @@ PRIVATE>
[ $subsection* ] each ($blank-line) ; [ $subsection* ] each ($blank-line) ;
: $subsection ( element -- ) : $subsection ( element -- )
first $subsection* ; check-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 check-first2 dup vocab-help
[ 2nip ($long-pretty-link) ] [ 2nip ($long-pretty-link) ]
[ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ] [ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ]
if* if*
] ($subsection) ; ] ($subsection) ;
: $vocab-link ( element -- ) : $vocab-link ( element -- )
first dup vocab-name swap ($vocab-link) ; check-first dup vocab-name swap ($vocab-link) ;
: $vocabulary ( element -- ) : $vocabulary ( element -- )
first vocabulary>> [ check-first vocabulary>> [
"Vocabulary" $heading nl dup ($vocab-link) "Vocabulary" $heading nl dup ($vocab-link)
] when* ; ] when* ;
@ -296,7 +309,7 @@ PRIVATE>
[ clear-unrelated-words ] [ notify-related-words ] bi ; [ clear-unrelated-words ] [ notify-related-words ] bi ;
: $related ( element -- ) : $related ( element -- )
first dup "related" word-prop remove check-first dup "related" word-prop remove
[ $see-also ] unless-empty ; [ $see-also ] unless-empty ;
: ($grid) ( style quot -- ) : ($grid) ( style quot -- )
@ -387,15 +400,15 @@ M: f ($instance)
] with-style ] with-style
] ($block) ; inline ] ($block) ; inline
: $see ( element -- ) first [ see* ] ($see) ; : $see ( element -- ) check-first [ see* ] ($see) ;
: $synopsis ( element -- ) first [ synopsis write ] ($see) ; : $synopsis ( element -- ) check-first [ synopsis write ] ($see) ;
: $definition ( element -- ) : $definition ( element -- )
"Definition" $heading $see ; "Definition" $heading $see ;
: $methods ( element -- ) : $methods ( element -- )
first methods [ check-first methods [
"Methods" $heading "Methods" $heading
[ see-all ] ($see) [ see-all ] ($see)
] unless-empty ; ] unless-empty ;
@ -403,7 +416,7 @@ M: f ($instance)
: $value ( object -- ) : $value ( object -- )
"Variable value" $heading "Variable value" $heading
"Current value in global namespace:" print-element "Current value in global namespace:" print-element
first dup [ pprint-short ] ($code) ; check-first dup [ pprint-short ] ($code) ;
: $curious ( element -- ) : $curious ( element -- )
"For the curious..." $heading print-element ; "For the curious..." $heading print-element ;