! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs continuations fry help help.lint.checks
-help.topics io kernel namespaces parser sequences
-source-files.errors vocabs.hierarchy vocabs words classes
-locals tools.errors ;
+USING: assocs combinators continuations fry help
+help.lint.checks help.topics io kernel namespaces parser
+sequences source-files.errors vocabs.hierarchy vocabs words
+classes locals tools.errors listener ;
FROM: help.lint.checks => all-vocabs ;
+FROM: vocabs => child-vocabs ;
IN: help.lint
SYMBOL: lint-failures
SYMBOL: +help-lint-failure+
-T{ error-type
+T{ error-type-holder
{ type +help-lint-failure+ }
{ word ":lint-failures" }
{ plural "help lint failures" }
PRIVATE>
-: help-lint-error ( error topic -- )
+: notify-help-lint-error ( error topic -- )
lint-failures get pick
[ [ [ <help-lint-error> ] keep ] dip set-at ] [ delete-at drop ] if
notify-error-observers ;
:: check-something ( topic quot -- )
[ quot call( -- ) f ] [ ] recover
- topic help-lint-error ; inline
+ topic notify-help-lint-error ; inline
: check-word ( word -- )
[ with-file-vocabs ] vocabs-quot set
dup word-help [
[ >link ] keep '[
- _ dup word-help
- [ check-values ]
- [ check-class-description ]
- [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ] 2tri
+ _ dup word-help {
+ [ check-values ]
+ [ check-value-effects ]
+ [ check-class-description ]
+ [ nip [ check-nulls ] [ check-see-also ] [ check-markup ] tri ]
+ } 2cleave
] check-something
] [ drop ] if ;
-: check-words ( words -- ) [ check-word ] each ;
-
: check-article ( article -- )
[ with-interactive-vocabs ] vocabs-quot set
>link dup '[
] check-something ;
: check-about ( vocab -- )
- dup '[ _ vocab-help [ article drop ] when* ] check-something ;
+ <vocab-link> dup
+ '[ _ vocab-help [ lookup-article drop ] when* ] check-something ;
: check-vocab ( vocab -- )
- "Checking " write dup write "..." print
- [ vocab check-about ]
+ "Checking " write dup write "..." print flush
+ [ check-about ]
[ words [ check-word ] each ]
[ vocab-articles get at [ check-article ] each ]
tri ;
: help-lint ( prefix -- )
[
- all-vocabs-seq [ vocab-name ] map all-vocabs set
+ auto-use? off
+ all-vocab-names all-vocabs set
group-articles vocab-articles set
child-vocabs
[ check-vocab ] each
: help-lint-all ( -- ) "" help-lint ;
-: :lint-failures ( -- ) lint-failures get errors. ;
+: :lint-failures ( -- ) lint-failures get values errors. ;
-: unlinked-words ( words -- seq )
- all-word-help [ article-parent not ] filter ;
+: unlinked-words ( vocab -- seq )
+ words all-word-help [ article-parent ] reject ;
: linked-undocumented-words ( -- seq )
all-words
- [ word-help not ] filter
+ [ word-help ] reject
[ article-parent ] filter
- [ predicate? not ] filter ;
-
-MAIN: help-lint
+ [ predicate? ] reject ;