Paste: pretty links including colored stack effect

Author: klazuka
Mode: factor
Date: Thu, 17 Sep 2009 19:16:51
Plain Text | 
: write-link ( string object -- )
    link-style get [ write-object ] with-style ;

GENERIC# write-link* 1 ( topic ? -- )

M: object write-link* [ >link ] dip write-link* ;

M: topic write-link*
    dupd [ article-title ] [ article-name ] if
    swap write-link ;

M: word write-link*
    not [ f call-next-method ] [
        dup f call-next-method
        stack-effect [ effect>string ] [ effect-style ] bi
        [ bl write ] with-style
    ] if ;

: (($link)) ( topic ? ? -- )
    [ dup string? [ >link ] when ] 2dip
    [ over definition-icon 1array $image " " print-element ] when
    [ write-link* ] ($span) ;

: ($link) ( topic -- ) f f (($link)) ;
: $link ( element -- ) first ($link) ;
: ($long-link) ( topic -- ) t f (($link)) ;
: $long-link ( element -- ) first ($long-link) ;
: ($pretty-link) ( topic -- ) f t (($link)) ;
: $pretty-link ( element -- ) first ($pretty-link) ;
: ($long-pretty-link) ( topic -- ) t t (($link)) ;
: $long-pretty-link ( element -- ) first ($long-pretty-link) ;

Annotation: round 2 - will not compile "cleave"

Author: klazuka
Mode: factor
Date: Thu, 17 Sep 2009 20:06:40
Plain Text | 
: write-link ( string object -- )
    link-style get [ write-object ] with-style ;

: link-icon ( topic -- )
    dup string? [ >link ] when
    definition-icon 1array $image " " print-element ;

: link-text ( topic -- )
    [ article-name ] keep write-link ;

: link-effect ( topic -- )
    dup word? [ 
        stack-effect [ effect>string ] [ effect-style ] bi
        [ bl write ] with-style
    ] [ drop ] if ;

: (($link)) ( topic words -- )
    [ cleave ] ($span) ;

: ($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) ;

New Annotation

Summary:
Author:
Mode:
Body: