1 ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs classes.algebra
4 combinators.short-circuit continuations io.directories
5 io.encodings.utf8 io.files io.pathnames kernel make math.parser
6 memoize namespaces sequences sets summary system vocabs
10 : check-vocab ( vocab -- vocab )
11 dup find-vocab-root [ no-vocab ] unless ;
13 MEMO: vocab-file-contents ( vocab name -- seq )
15 [ dup exists? [ utf8 file-lines ] [ drop f ] if ] when ;
17 : set-vocab-file-contents ( seq vocab name -- )
18 dupd vocab-append-path [
19 swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
20 \ vocab-file-contents reset-memoized
21 ] [ vocab-name no-vocab ] ?if ;
23 : vocab-windows-icon-path ( vocab -- string )
24 vocab-dir "icon.ico" append-path ;
26 : vocab-mac-icon-path ( vocab -- string )
27 vocab-dir "icon.icns" append-path ;
29 : vocab-resources-path ( vocab -- string )
30 vocab-dir "resources.txt" append-path ;
32 : vocab-resources ( vocab -- patterns )
33 dup vocab-resources-path vocab-file-contents harvest ;
35 : set-vocab-resources ( patterns vocab -- )
36 dup vocab-resources-path set-vocab-file-contents ;
38 : vocab-summary-path ( vocab -- string )
39 vocab-dir "summary.txt" append-path ;
41 : vocab-summary ( vocab -- summary )
42 dup dup vocab-summary-path vocab-file-contents
44 vocab-name " vocabulary" append
57 M: vocab-link summary vocab-summary ;
59 : set-vocab-summary ( string vocab -- )
61 dup vocab-summary-path
62 set-vocab-file-contents ;
64 : vocab-tags-path ( vocab -- string )
65 vocab-dir "tags.txt" append-path ;
67 : vocab-tags ( vocab -- tags )
68 dup vocab-tags-path vocab-file-contents harvest ;
70 : set-vocab-tags ( tags vocab -- )
71 dup vocab-tags-path set-vocab-file-contents ;
73 : add-vocab-tags ( tags vocab -- )
74 [ vocab-tags append members ] keep set-vocab-tags ;
76 : remove-vocab-tags ( tags vocab -- )
77 [ vocab-tags swap diff ] keep set-vocab-tags ;
79 : vocab-authors-path ( vocab -- string )
80 vocab-dir "authors.txt" append-path ;
82 : vocab-authors ( vocab -- authors )
83 dup vocab-authors-path vocab-file-contents harvest ;
85 : set-vocab-authors ( authors vocab -- )
86 dup vocab-authors-path set-vocab-file-contents ;
88 : vocab-platforms-path ( vocab -- string )
89 vocab-dir "platforms.txt" append-path ;
91 ERROR: bad-platform name ;
93 : vocab-platforms ( vocab -- platforms )
94 dup vocab-platforms-path vocab-file-contents
95 [ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ;
97 : set-vocab-platforms ( platforms vocab -- )
98 [ [ name>> ] map ] dip
99 dup vocab-platforms-path set-vocab-file-contents ;
101 : supported-platform? ( platforms -- ? )
102 [ t ] [ [ os swap class<= ] any? ] if-empty ;
104 : don't-load? ( vocab -- ? )
106 [ vocab-tags "not loaded" swap member? ]
107 [ vocab-platforms supported-platform? not ]
110 : filter-don't-load ( vocabs -- vocabs' )
111 [ vocab-name don't-load? not ] filter ;
113 : don't-test? ( vocab -- ? )
114 vocab-tags "not tested" swap member? ;
116 : filter-don't-test ( vocabs -- vocabs' )
117 [ don't-test? not ] filter ;
119 TUPLE: unsupported-platform vocab requires ;
121 : throw-unsupported-platform ( vocab requires -- )
122 \ unsupported-platform boa throw-continue ;
124 M: unsupported-platform summary
125 drop "Current operating system not supported by this vocabulary" ;
128 dup vocab-platforms dup supported-platform?
129 [ 2drop ] [ [ vocab-name ] dip throw-unsupported-platform ] if
130 ] check-vocab-hook set-global