new accessors

db4
Doug Coleman 2008-08-29 02:14:01 -05:00
parent 42bd621cce
commit 99a79bb080
2 changed files with 11 additions and 13 deletions

View File

@ -143,13 +143,13 @@ M: f print-element drop ;
link-style get [ write-object ] with-style ; link-style get [ write-object ] with-style ;
: ($link) ( article -- ) : ($link) ( article -- )
[ dup article-name swap >link write-link ] ($span) ; [ [ name>> ] [ >link ] bi write-link ] ($span) ;
: $link ( element -- ) : $link ( element -- )
first ($link) ; first ($link) ;
: ($long-link) ( object -- ) : ($long-link) ( object -- )
dup article-title swap >link write-link ; dup title>> swap >link write-link ;
: ($subsection) ( element quot -- ) : ($subsection) ( element quot -- )
[ [

View File

@ -1,6 +1,6 @@
! Copyright (C) 2005, 2007 Slava Pestov. ! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.x ! See http://factorcode.org/license.txt for BSD license.x
USING: arrays definitions generic assocs USING: accessors arrays definitions generic assocs
io kernel namespaces prettyprint prettyprint.sections io kernel namespaces prettyprint prettyprint.sections
sequences words summary classes strings vocabs ; sequences words summary classes strings vocabs ;
IN: help.topics IN: help.topics
@ -16,12 +16,12 @@ M: link >link ;
M: vocab-spec >link ; M: vocab-spec >link ;
M: object >link link boa ; M: object >link link boa ;
PREDICATE: word-link < link link-name word? ; PREDICATE: word-link < link name>> word? ;
M: link summary M: link summary
[ [
"Link: " % "Link: " %
link-name dup word? [ summary ] [ unparse ] if % name>> dup word? [ summary ] [ unparse ] if %
] "" make ; ] "" make ;
! Help articles ! Help articles
@ -44,9 +44,7 @@ TUPLE: article title content loc ;
M: article article-name article-title ; M: article article-name article-title ;
TUPLE: no-article name ; ERROR: no-article name ;
: no-article ( name -- * ) \ no-article boa throw ;
M: no-article summary M: no-article summary
drop "Help article does not exist" ; drop "Help article does not exist" ;
@ -60,11 +58,11 @@ M: object article-content article article-content ;
M: object article-parent article-xref get at ; M: object article-parent article-xref get at ;
M: object set-article-parent article-xref get set-at ; M: object set-article-parent article-xref get set-at ;
M: link article-name link-name article-name ; M: link article-name name>> article-name ;
M: link article-title link-name article-title ; M: link article-title name>> article-title ;
M: link article-content link-name article-content ; M: link article-content name>> article-content ;
M: link article-parent link-name article-parent ; M: link article-parent name>> article-parent ;
M: link set-article-parent link-name set-article-parent ; M: link set-article-parent name>> set-article-parent ;
! Special case: f help ! Special case: f help
M: f article-name drop \ f article-name ; M: f article-name drop \ f article-name ;