From fbc1076ac2f780eb060db518240ab40ec7b2ac9c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 31 Aug 2008 02:52:02 -0500 Subject: [PATCH] new accessors --- extra/faq/faq.factor | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index 3cb17cf08b..47d3727703 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: xml kernel sequences xml.utilities combinators.lib math xml.data arrays assocs xml.generator xml.writer namespaces -math.parser io ; +math.parser io accessors ; IN: faq : find-after ( seq quot -- elem after ) @@ -21,16 +21,16 @@ C: q/a >r tag-children r> ; : q/a>li ( q/a -- li ) - [ q/a-question "strong" build-tag* f "br" build-tag* 2array ] keep - q/a-answer append "li" build-tag* ; + [ question>> "strong" build-tag* f "br" build-tag* 2array ] keep + answer>> append "li" build-tag* ; : xml>q/a ( xml -- q/a ) [ "question" tag-named tag-children ] keep "answer" tag-named tag-children ; : q/a>xml ( q/a -- xml ) - [ q/a-question "question" build-tag* ] keep - q/a-answer "answer" build-tag* + [ question>> "question" build-tag* ] keep + answer>> "answer" build-tag* "\n" swap 3array "qa" build-tag* ; ! Lists of questions @@ -43,23 +43,23 @@ C: question-list ; : question-list>xml ( question-list -- list ) - [ question-list-seq [ q/a>xml "\n" swap 2array ] + [ seq>> [ q/a>xml "\n" swap 2array ] map concat "list" build-tag* ] keep - question-list-title [ "title" pick set-at ] when* ; + title>> [ "title" pick set-at ] when* ; : html>question-list ( h3 ol -- question-list ) >r [ children>string ] [ f ] if* r> children-tags [ li>q/a ] map ; : question-list>h3 ( id question-list -- h3 ) - question-list-title [ + title>> [ "h3" build-tag swap number>string "id" pick set-at ] [ drop f ] if* ; : question-list>html ( question-list start id -- h3/f ol ) -rot >r [ question-list>h3 ] keep - question-list-seq [ q/a>li ] map "ol" build-tag* r> + seq>> [ q/a>li ] map "ol" build-tag* r> number>string "start" pick set-at "margin-left: 5em" "style" pick set-at ; @@ -72,32 +72,32 @@ C: faq first2 >r f prefix r> [ html>question-list ] 2map ; : header, ( faq -- ) - dup faq-header , - faq-lists first 1 -1 question-list>html nip , ; + dup header>> , + lists>> first 1 -1 question-list>html nip , ; : br, ( -- ) "br" contained, nl, ; : toc-link, ( question-list number -- ) number>string "#" prepend "href" swap 2array 1array - "a" swap [ question-list-title , ] tag*, br, ; + "a" swap [ title>> , ] tag*, br, ; : toc, ( faq -- ) "div" { { "style" "background-color: #eee; margin-left: 30%; margin-right: 30%; width: auto; padding: 5px; margin-top: 1em; margin-bottom: 1em" } } [ "strong" [ "The big questions" , ] tag, br, - faq-lists rest dup length [ toc-link, ] 2each + lists>> rest dup length [ toc-link, ] 2each ] tag*, ; : faq-sections, ( question-lists -- ) - unclip question-list-seq length 1+ dupd - [ question-list-seq length + ] accumulate nip + unclip seq>> length 1+ dupd + [ seq>> length + ] accumulate nip 0 -rot [ pick question-list>html [ , nl, ] bi@ 1+ ] 2each drop ; : faq>html ( faq -- div ) "div" [ dup header, dup toc, - faq-lists faq-sections, + lists>> faq-sections, ] make-xml ; : xml>faq ( xml -- faq ) @@ -106,8 +106,8 @@ C: faq : faq>xml ( faq -- xml ) "faq" [ - "header" [ dup faq-header , ] tag, - faq-lists [ question-list>xml , nl, ] each + "header" [ dup header>> , ] tag, + lists>> [ question-list>xml , nl, ] each ] make-xml ; : read-write-faq ( xml-stream -- )