1 ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs io.directories io.encodings.utf8
4 io.files io.pathnames kernel make math.parser memoize sequences
5 sets sorting summary vocabs vocabs.loader words system
6 classes.algebra combinators.short-circuit fry continuations
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 : ?delete-file ( pathname -- ) '[ _ delete-file ] ignore-errors ;
19 : set-vocab-file-contents ( seq vocab name -- )
20 dupd vocab-append-path [
21 swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty
22 \ vocab-file-contents reset-memoized
23 ] [ vocab-name no-vocab ] ?if ;
25 : vocab-windows-icon-path ( vocab -- string )
26 vocab-dir "icon.ico" append-path ;
28 : vocab-mac-icon-path ( vocab -- string )
29 vocab-dir "icon.icns" append-path ;
31 : vocab-resources-path ( vocab -- string )
32 vocab-dir "resources.txt" append-path ;
34 : vocab-resources ( vocab -- patterns )
35 dup vocab-resources-path vocab-file-contents harvest ;
37 : set-vocab-resources ( patterns vocab -- )
38 dup vocab-resources-path set-vocab-file-contents ;
40 : vocab-summary-path ( vocab -- string )
41 vocab-dir "summary.txt" append-path ;
43 : vocab-summary ( vocab -- summary )
44 dup dup vocab-summary-path vocab-file-contents
46 vocab-name " vocabulary" append
59 M: vocab-link summary vocab-summary ;
61 : set-vocab-summary ( string vocab -- )
63 dup vocab-summary-path
64 set-vocab-file-contents ;
66 : vocab-tags-path ( vocab -- string )
67 vocab-dir "tags.txt" append-path ;
69 : vocab-tags ( vocab -- tags )
70 dup vocab-tags-path vocab-file-contents harvest ;
72 : set-vocab-tags ( tags vocab -- )
73 dup vocab-tags-path set-vocab-file-contents ;
75 : add-vocab-tags ( tags vocab -- )
76 [ vocab-tags append members ] keep set-vocab-tags ;
78 : remove-vocab-tags ( tags vocab -- )
79 [ vocab-tags swap diff ] keep set-vocab-tags ;
81 : vocab-authors-path ( vocab -- string )
82 vocab-dir "authors.txt" append-path ;
84 : vocab-authors ( vocab -- authors )
85 dup vocab-authors-path vocab-file-contents harvest ;
87 : set-vocab-authors ( authors vocab -- )
88 dup vocab-authors-path set-vocab-file-contents ;
90 : vocab-platforms-path ( vocab -- string )
91 vocab-dir "platforms.txt" append-path ;
93 ERROR: bad-platform name ;
95 : vocab-platforms ( vocab -- platforms )
96 dup vocab-platforms-path vocab-file-contents
97 [ dup "system" lookup [ ] [ bad-platform ] ?if ] map ;
99 : set-vocab-platforms ( platforms vocab -- )
100 [ [ name>> ] map ] dip
101 dup vocab-platforms-path set-vocab-file-contents ;
103 : supported-platform? ( platforms -- ? )
104 [ t ] [ [ os swap class<= ] any? ] if-empty ;
106 : unportable? ( vocab -- ? )
108 [ vocab-tags "untested" swap member? ]
109 [ vocab-platforms supported-platform? not ]
112 TUPLE: unsupported-platform vocab requires ;
114 : unsupported-platform ( vocab requires -- )
115 \ unsupported-platform boa throw-continue ;
117 M: unsupported-platform summary
118 drop "Current operating system not supported by this vocabulary" ;
121 dup vocab-platforms dup supported-platform?
122 [ 2drop ] [ [ vocab-name ] dip unsupported-platform ] if
123 ] check-vocab-hook set-global