Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
27f1a33fb2
|
|
@ -5,7 +5,7 @@ IN: bootstrap.help
|
|||
|
||||
: load-help ( -- )
|
||||
"help.lint" require
|
||||
"tools.vocabs.browser" require
|
||||
"help.vocabs" require
|
||||
"alien.syntax" require
|
||||
"compiler" require
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,6 @@ IN: bootstrap.tools
|
|||
"tools.time"
|
||||
"tools.threads"
|
||||
"tools.vocabs"
|
||||
"tools.vocabs.browser"
|
||||
"tools.vocabs.monitor"
|
||||
"editors"
|
||||
} [ require ] each
|
||||
|
|
|
|||
|
|
@ -46,6 +46,11 @@ IN: calendar.format
|
|||
|
||||
: read-0000 ( -- n ) 4 read string>number ;
|
||||
|
||||
: hhmm>timestamp ( hhmm -- timestamp )
|
||||
[
|
||||
0 0 0 read-00 read-00 0 instant <timestamp>
|
||||
] with-string-reader ;
|
||||
|
||||
GENERIC: day. ( obj -- )
|
||||
|
||||
M: integer day. ( n -- )
|
||||
|
|
|
|||
|
|
@ -22,15 +22,13 @@ SYMBOL: super-message-senders
|
|||
message-senders [ H{ } clone ] initialize
|
||||
super-message-senders [ H{ } clone ] initialize
|
||||
|
||||
: cache-stub ( method function hash -- )
|
||||
[
|
||||
over get [ 2drop ] [ over [ sender-stub ] dip set ] if
|
||||
] bind ;
|
||||
: cache-stub ( method assoc function -- )
|
||||
'[ _ sender-stub ] cache drop ;
|
||||
|
||||
: cache-stubs ( method -- )
|
||||
dup
|
||||
"objc_msgSendSuper" super-message-senders get cache-stub
|
||||
"objc_msgSend" message-senders get cache-stub ;
|
||||
[ super-message-senders get "objc_msgSendSuper" cache-stub ]
|
||||
[ message-senders get "objc_msgSend" cache-stub ]
|
||||
bi ;
|
||||
|
||||
: <super> ( receiver -- super )
|
||||
"objc-super" <c-object> [
|
||||
|
|
|
|||
|
|
@ -89,4 +89,4 @@ PRIVATE>
|
|||
-> locationInWindow f -> convertPoint:fromView:
|
||||
[ CGPoint-x ] [ CGPoint-y ] bi
|
||||
] [ drop -> frame CGRect-h ] 2bi
|
||||
swap - 2array ;
|
||||
swap - [ >integer ] bi@ 2array ;
|
||||
|
|
|
|||
|
|
@ -97,8 +97,7 @@ HELP: <clumps>
|
|||
{ $example
|
||||
"USING: grouping sequences math prettyprint kernel ;"
|
||||
"IN: scratchpad"
|
||||
": share-price"
|
||||
" { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 } ;"
|
||||
"CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }"
|
||||
""
|
||||
"share-price 4 <clumps> [ [ sum ] [ length ] bi / ] map ."
|
||||
"{ 113/400 167/400 201/400 241/400 243/400 91/200 1/4 }"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,8 @@
|
|||
IN: tools.apropos
|
||||
USING: help.markup help.syntax strings ;
|
||||
IN: help.apropos
|
||||
USING: help.markup help.syntax strings help.tips ;
|
||||
|
||||
HELP: apropos
|
||||
{ $values { "str" string } }
|
||||
{ $description "Lists all words, vocabularies and help articles whose name contains a subsequence equal to " { $snippet "str" } ". Results are ranked using a simple distance algorithm." } ;
|
||||
|
||||
TIP: "Use " { $link apropos } " to search for words, vocabularies and help articles." ;
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
IN: help.apropos.tests
|
||||
USING: help.apropos tools.test ;
|
||||
|
||||
[ ] [ "swp" apropos ] unit-test
|
||||
|
|
@ -2,9 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs fry help.markup help.topics io
|
||||
kernel make math math.parser namespaces sequences sorting
|
||||
summary tools.completion tools.vocabs tools.vocabs.browser
|
||||
summary tools.completion tools.vocabs help.vocabs
|
||||
vocabs words unicode.case help ;
|
||||
IN: tools.apropos
|
||||
IN: help.apropos
|
||||
|
||||
: $completions ( seq -- )
|
||||
dup [ word? ] all? [ words-table ] [
|
||||
|
|
@ -67,5 +67,9 @@ M: apropos article-name article-title ;
|
|||
M: apropos article-content
|
||||
search>> 1array \ $apropos prefix ;
|
||||
|
||||
M: apropos >link ;
|
||||
|
||||
INSTANCE: apropos topic
|
||||
|
||||
: apropos ( str -- )
|
||||
<apropos> print-topic ;
|
||||
|
|
@ -121,16 +121,16 @@ $nl
|
|||
"sequences"
|
||||
} ;
|
||||
|
||||
ARTICLE: "cookbook-variables" "Variables cookbook"
|
||||
"Before using a variable, you must define a symbol for it:"
|
||||
{ $code "SYMBOL: name" }
|
||||
ARTICLE: "cookbook-variables" "Dynamic variables cookbook"
|
||||
"A symbol is a word which pushes itself on the stack when executed. Try it:"
|
||||
{ $example "SYMBOL: foo" "foo ." "foo" }
|
||||
"Before using a variable, you must define a symbol for it:"
|
||||
{ $code "SYMBOL: name" }
|
||||
"Symbols can be passed to the " { $link get } " and " { $link set } " words to read and write variable values:"
|
||||
{ $example "\"Slava\" name set" "name get print" "Slava" }
|
||||
{ $unchecked-example "\"Slava\" name set" "name get print" "Slava" }
|
||||
"If you set variables inside a " { $link with-scope } ", their values will be lost after leaving the scope:"
|
||||
{ $example
|
||||
": print-name name get print ;"
|
||||
{ $unchecked-example
|
||||
": print-name ( -- ) name get print ;"
|
||||
"\"Slava\" name set"
|
||||
"["
|
||||
" \"Diana\" name set"
|
||||
|
|
@ -139,11 +139,8 @@ ARTICLE: "cookbook-variables" "Variables cookbook"
|
|||
"\"Here, the name is \" write print-name"
|
||||
"There, the name is Diana\nHere, the name is Slava"
|
||||
}
|
||||
{ $curious
|
||||
"Variables are dynamically-scoped in Factor."
|
||||
}
|
||||
{ $references
|
||||
"There is a lot more to be said about variables and namespaces."
|
||||
"There is a lot more to be said about dynamically-scoped variables and namespaces."
|
||||
"namespaces"
|
||||
} ;
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ prettyprint.backend prettyprint.custom kernel.private io generic
|
|||
math system strings sbufs vectors byte-arrays quotations
|
||||
io.streams.byte-array classes.builtin parser lexer
|
||||
classes.predicate classes.union classes.intersection
|
||||
classes.singleton classes.tuple tools.vocabs.browser math.parser
|
||||
classes.singleton classes.tuple help.vocabs math.parser
|
||||
accessors ;
|
||||
IN: help.handbook
|
||||
|
||||
|
|
@ -278,11 +278,7 @@ ARTICLE: "handbook-library-reference" "Library reference"
|
|||
"This index only includes articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "."
|
||||
{ $index [ "handbook" orphan-articles remove ] } ;
|
||||
|
||||
ARTICLE: "handbook" "Factor documentation"
|
||||
"Welcome to Factor."
|
||||
$nl
|
||||
"Explore the code base:"
|
||||
{ $subsection "vocab-index" }
|
||||
ARTICLE: "handbook" "Factor handbook"
|
||||
"Learn the language:"
|
||||
{ $subsection "cookbook" }
|
||||
{ $subsection "first-program" }
|
||||
|
|
@ -290,11 +286,13 @@ $nl
|
|||
{ $subsection "handbook-environment-reference" }
|
||||
{ $subsection "ui" }
|
||||
{ $subsection "handbook-library-reference" }
|
||||
"The below indices only include articles from loaded vocabularies. To explore more vocabularies, see " { $link "vocab-index" } "."
|
||||
"Explore loaded libraries:"
|
||||
{ $subsection "article-index" }
|
||||
{ $subsection "primitive-index" }
|
||||
{ $subsection "error-index" }
|
||||
{ $subsection "type-index" }
|
||||
{ $subsection "class-index" } ;
|
||||
{ $subsection "class-index" }
|
||||
"Explore the code base:"
|
||||
{ $subsection "vocab-index" } ;
|
||||
|
||||
ABOUT: "handbook"
|
||||
|
|
|
|||
|
|
@ -127,6 +127,7 @@ ARTICLE: "help" "Help system"
|
|||
{ $subsection "browsing-help" }
|
||||
{ $subsection "writing-help" }
|
||||
{ $subsection "help.lint" }
|
||||
{ $subsection "tips-of-the-day" }
|
||||
{ $subsection "help-impl" } ;
|
||||
|
||||
IN: help
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
IN: help.home
|
||||
USING: help.markup help.syntax ;
|
||||
|
||||
ARTICLE: "help.home" "Factor documentation"
|
||||
{ $heading "Starting points" }
|
||||
{ $list
|
||||
{ $link "ui-listener" }
|
||||
{ $link "handbook" }
|
||||
{ $link "vocab-index" }
|
||||
}
|
||||
{ $heading "Recently visited" }
|
||||
{ $table
|
||||
{ "Words" "Articles" "Vocabs" }
|
||||
{ { $recent recent-words } { $recent recent-articles } { $recent recent-vocabs } }
|
||||
} print-element
|
||||
{ $heading "Recent searches" }
|
||||
{ $recent-searches } ;
|
||||
|
||||
ABOUT: "help.home"
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays compiler.units fry hashtables help.topics io
|
||||
kernel math namespaces sequences sets help.vocabs
|
||||
help.apropos vocabs help.markup ;
|
||||
IN: help.home
|
||||
|
||||
SYMBOLS: recent-words recent-articles recent-vocabs recent-searches ;
|
||||
|
||||
CONSTANT: recent-count 10
|
||||
|
||||
{ recent-words recent-articles recent-vocabs recent-searches }
|
||||
[ [ V{ } clone ] initialize ] each
|
||||
|
||||
GENERIC: add-recent-where ( obj -- obj symbol )
|
||||
|
||||
M: link add-recent-where recent-articles ;
|
||||
M: word-link add-recent-where recent-words ;
|
||||
M: vocab-spec add-recent-where recent-vocabs ;
|
||||
M: apropos add-recent-where recent-searches ;
|
||||
M: object add-recent-where f ;
|
||||
|
||||
: $recent ( element -- )
|
||||
first get [ nl ] [ 1array $pretty-link ] interleave ;
|
||||
|
||||
: $recent-searches ( element -- )
|
||||
drop recent-searches get [ nl ] [ ($link) ] interleave ;
|
||||
|
||||
: redisplay-recent-page ( -- )
|
||||
"help.home" >link dup associate
|
||||
notify-definition-observers ;
|
||||
|
||||
: expire ( seq -- )
|
||||
[ length recent-count - [ 0 > ] keep ] keep
|
||||
'[ 0 _ _ delete-slice ] when ;
|
||||
|
||||
: add-recent ( obj -- )
|
||||
add-recent-where dup
|
||||
[ get [ adjoin ] [ expire ] bi ] [ 2drop ] if
|
||||
redisplay-recent-page ;
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary
|
||||
io.files io.files.temp io.directories html.streams help kernel
|
||||
assocs sequences make words accessors arrays help.topics vocabs
|
||||
tools.vocabs tools.vocabs.browser namespaces prettyprint io
|
||||
tools.vocabs help.vocabs namespaces prettyprint io
|
||||
vocabs.loader serialize fry memoize unicode.case math.order
|
||||
sorting debugger html xml.syntax xml.writer ;
|
||||
IN: help.html
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
IN: help.tips
|
||||
USING: help.markup help.syntax debugger ;
|
||||
|
||||
TIP: "To look at the most recent error, run " { $link :error } ". To look at the most recent error's callstack, run " { $link :c } "." ;
|
||||
|
||||
TIP: "Learn to use " { $link "dataflow-combinators" } "." ;
|
||||
|
||||
TIP: "Learn to use " { $link "editor" } " to be able to jump to the source code for word definitions from the listener." ;
|
||||
|
||||
TIP: "Check out " { $url "http://concatenative.org/wiki/view/Factor/FAQ" } " to get answers to frequently-asked questions." ;
|
||||
|
||||
TIP: "Drop by the " { $snippet "#concatenative" } " IRC channel on " { $snippet "irc.freenode.net" } " some time." ;
|
||||
|
||||
TIP: "You can write documentation for your own code using the " { $link "help" } "." ;
|
||||
|
||||
TIP: "You can write graphical applications using the " { $link "ui" } "." ;
|
||||
|
||||
ARTICLE: "all-tips-of-the-day" "All tips of the day"
|
||||
{ $tips-of-the-day } ;
|
||||
|
||||
ARTICLE: "tips-of-the-day" "Tips of the day"
|
||||
"The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:"
|
||||
{ $subsection POSTPONE: TIP: }
|
||||
"All tips defined so far:"
|
||||
{ $subsection "all-tips-of-the-day" } ;
|
||||
|
||||
ABOUT: "tips-of-the-day"
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: parser arrays namespaces sequences random help.markup kernel io
|
||||
io.styles colors.constants ;
|
||||
IN: help.tips
|
||||
|
||||
SYMBOL: tips
|
||||
|
||||
tips [ V{ } clone ] initialize
|
||||
|
||||
SYNTAX: TIP: parse-definition >array tips get push ;
|
||||
|
||||
: a-tip ( -- tip ) tips get random ;
|
||||
|
||||
SYMBOL: tip-of-the-day-style
|
||||
|
||||
H{
|
||||
{ page-color COLOR: lavender }
|
||||
{ border-width 5 }
|
||||
{ wrap-margin 500 }
|
||||
} tip-of-the-day-style set-global
|
||||
|
||||
: $tip-of-the-day ( element -- )
|
||||
drop
|
||||
[
|
||||
tip-of-the-day-style get
|
||||
[
|
||||
last-element off
|
||||
"Tip of the day" $heading a-tip print-element nl
|
||||
"— " print-element "all-tips-of-the-day" ($link)
|
||||
]
|
||||
with-nesting
|
||||
] ($heading) ;
|
||||
|
||||
: tip-of-the-day. ( -- ) { $tip-of-the-day } print-content nl ;
|
||||
|
||||
: $tips-of-the-day ( element -- )
|
||||
drop tips get [ nl nl ] [ print-element ] interleave ;
|
||||
|
|
@ -62,7 +62,9 @@ ARTICLE: "first-program-test" "Testing your first program"
|
|||
""
|
||||
": palindrome? ( str -- ? ) dup reverse = ;"
|
||||
}
|
||||
"We will now test our new word in the listener. First, push a string on the stack:"
|
||||
"We will now test our new word in the listener. First we have add the palindrome vocabulary to the listener's vocabulary search path:"
|
||||
{ $code "USE: palindrome"}
|
||||
"Next, push a string on the stack:"
|
||||
{ $code "\"hello\"" }
|
||||
"Note that the stack display in the listener now shows this string. Having supplied the input, we call our word:"
|
||||
{ $code "palindrome?" }
|
||||
|
|
@ -132,6 +134,8 @@ $nl
|
|||
$nl
|
||||
"We modify " { $snippet "palindrome?" } " to first apply " { $snippet "normalize" } " to its input:"
|
||||
{ $code ": palindrome? ( str -- ? ) normalize dup reverse = ;" }
|
||||
"Factor compiles the file from the top down. So, be sure to place the definition for " { $snippet "normalize" } " above the definition for " { $snippet "palindrome?" } "."
|
||||
$nl
|
||||
"Now if you press " { $command tool "common" refresh-all } ", the source file should reload without any errors. You can run unit tests again, and this time, they will all pass:"
|
||||
{ $code "\"palindrome\" test" } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
USING: help.markup help.syntax io strings ;
|
||||
IN: tools.vocabs.browser
|
||||
IN: help.vocabs
|
||||
|
||||
ARTICLE: "vocab-tags" "Vocabulary tags"
|
||||
{ $all-tags } ;
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
IN: help.vocabs.tests
|
||||
USING: help.vocabs tools.test help.markup help vocabs ;
|
||||
|
||||
[ ] [ { $vocab "scratchpad" } print-content ] unit-test
|
||||
[ ] [ "classes" vocab print-topic ] unit-test
|
||||
|
|
@ -6,17 +6,16 @@ classes.singleton classes.tuple classes.union combinators
|
|||
definitions effects fry generic help help.markup help.stylesheet
|
||||
help.topics io io.files io.pathnames io.styles kernel macros
|
||||
make namespaces prettyprint sequences sets sorting summary
|
||||
tools.vocabs vocabs vocabs.loader words words.symbol
|
||||
combinators.smart definitions.icons ;
|
||||
IN: tools.vocabs.browser
|
||||
tools.vocabs vocabs vocabs.loader words words.symbol definitions.icons ;
|
||||
IN: help.vocabs
|
||||
|
||||
: $pretty-link ( element -- )
|
||||
[ first definition-icon 1array $image " " print-element ]
|
||||
[ $definition-link ]
|
||||
bi ;
|
||||
|
||||
: <$pretty-link> ( definition -- element )
|
||||
[
|
||||
[ definition-icon 1array \ $image prefix ]
|
||||
[ drop " " ]
|
||||
[ 1array \ $definition-link prefix ]
|
||||
tri
|
||||
] output>array ;
|
||||
1array \ $pretty-link prefix ;
|
||||
|
||||
: vocab-row ( vocab -- row )
|
||||
[ <$pretty-link> ] [ vocab-summary ] bi 2array ;
|
||||
|
|
@ -108,7 +108,7 @@ HELP: lappend
|
|||
{ $description "Perform a similar functionality to that of the " { $link append } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-append> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required. Successive calls to " { $link cdr } " will iterate through list1, followed by list2." } ;
|
||||
|
||||
HELP: lfrom-by
|
||||
{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "list" "a lazy list of integers" } }
|
||||
{ $values { "n" "an integer" } { "quot" { $quotation "( -- int )" } } { "lazy-from-by" "a lazy list of integers" } }
|
||||
{ $description "Return an infinite lazy list of values starting from n, with each successive value being the result of applying quot to n." } ;
|
||||
|
||||
HELP: lfrom
|
||||
|
|
|
|||
|
|
@ -203,7 +203,7 @@ M: lazy-append nil? ( lazy-append -- bool )
|
|||
|
||||
TUPLE: lazy-from-by n quot ;
|
||||
|
||||
C: lfrom-by lazy-from-by ( n quot -- list )
|
||||
C: lfrom-by lazy-from-by
|
||||
|
||||
: lfrom ( n -- list )
|
||||
[ 1+ ] lfrom-by ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@ USING: locals math sequences tools.test hashtables words kernel
|
|||
namespaces arrays strings prettyprint io.streams.string parser
|
||||
accessors generic eval combinators combinators.short-circuit
|
||||
combinators.short-circuit.smart math.order math.functions
|
||||
definitions compiler.units fry lexer words.symbol see ;
|
||||
definitions compiler.units fry lexer words.symbol see multiline ;
|
||||
IN: locals.tests
|
||||
|
||||
:: foo ( a b -- a a ) a a ;
|
||||
|
|
@ -392,6 +392,65 @@ ERROR: punned-class x ;
|
|||
|
||||
[ 9 ] [ 3 big-case-test ] unit-test
|
||||
|
||||
! Dan found this problem
|
||||
: littledan-case-problem-1 ( a -- b )
|
||||
{
|
||||
{ t [ 3 ] }
|
||||
{ f [ 4 ] }
|
||||
[| x | x 12 + { "howdy" } nth ]
|
||||
} case ;
|
||||
|
||||
\ littledan-case-problem-1 must-infer
|
||||
|
||||
[ "howdy" ] [ -12 \ littledan-case-problem-1 def>> call ] unit-test
|
||||
[ "howdy" ] [ -12 littledan-case-problem-1 ] unit-test
|
||||
|
||||
:: littledan-case-problem-2 ( a -- b )
|
||||
a {
|
||||
{ t [ a not ] }
|
||||
{ f [ 4 ] }
|
||||
[| x | x a - { "howdy" } nth ]
|
||||
} case ;
|
||||
|
||||
\ littledan-case-problem-2 must-infer
|
||||
|
||||
[ "howdy" ] [ -12 \ littledan-case-problem-2 def>> call ] unit-test
|
||||
[ "howdy" ] [ -12 littledan-case-problem-2 ] unit-test
|
||||
|
||||
:: littledan-cond-problem-1 ( a -- b )
|
||||
a {
|
||||
{ [ dup 0 < ] [ drop a not ] }
|
||||
{ [| y | y y 0 > ] [ drop 4 ] }
|
||||
[| x | x a - { "howdy" } nth ]
|
||||
} cond ;
|
||||
|
||||
\ littledan-cond-problem-1 must-infer
|
||||
|
||||
[ f ] [ -12 \ littledan-cond-problem-1 def>> call ] unit-test
|
||||
[ 4 ] [ 12 \ littledan-cond-problem-1 def>> call ] unit-test
|
||||
[ "howdy" ] [ 0 \ littledan-cond-problem-1 def>> call ] unit-test
|
||||
[ f ] [ -12 littledan-cond-problem-1 ] unit-test
|
||||
[ 4 ] [ 12 littledan-cond-problem-1 ] unit-test
|
||||
[ "howdy" ] [ 0 littledan-cond-problem-1 ] unit-test
|
||||
|
||||
/*
|
||||
:: littledan-case-problem-3 ( a quot -- b )
|
||||
a {
|
||||
{ t [ a not ] }
|
||||
{ f [ 4 ] }
|
||||
quot
|
||||
} case ; inline
|
||||
|
||||
[ f ] [ t [ ] littledan-case-problem-3 ] unit-test
|
||||
[ 144 ] [ 12 [ sq ] littledan-case-problem-3 ] unit-test
|
||||
[| | [| a | a ] littledan-case-problem-3 ] must-infer
|
||||
|
||||
: littledan-case-problem-4 ( a -- b )
|
||||
[ 1 + ] littledan-case-problem-3 ;
|
||||
|
||||
\ littledan-case-problem-4 must-infer
|
||||
*/
|
||||
|
||||
GENERIC: lambda-method-forget-test ( a -- b )
|
||||
|
||||
M:: integer lambda-method-forget-test ( a -- b ) ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs kernel locals.types macros.expander ;
|
||||
USING: accessors assocs kernel locals.types macros.expander fry ;
|
||||
IN: locals.macros
|
||||
|
||||
M: lambda expand-macros clone [ expand-macros ] change-body ;
|
||||
|
|
@ -14,3 +14,6 @@ M: binding-form expand-macros
|
|||
|
||||
M: binding-form expand-macros* expand-macros literal ;
|
||||
|
||||
M: lambda condomize? drop t ;
|
||||
|
||||
M: lambda condomize '[ @ ] ;
|
||||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel sequences sequences.private namespaces make
|
||||
quotations accessors words continuations vectors effects math
|
||||
generalizations fry ;
|
||||
generalizations fry arrays ;
|
||||
IN: macros.expander
|
||||
|
||||
GENERIC: expand-macros ( quot -- quot' )
|
||||
|
|
@ -17,7 +17,23 @@ SYMBOL: stack
|
|||
[ delete-all ]
|
||||
bi ;
|
||||
|
||||
: literal ( obj -- ) stack get push ;
|
||||
GENERIC: condomize? ( obj -- ? )
|
||||
|
||||
M: array condomize? [ condomize? ] any? ;
|
||||
|
||||
M: callable condomize? [ condomize? ] any? ;
|
||||
|
||||
M: object condomize? drop f ;
|
||||
|
||||
GENERIC: condomize ( obj -- obj' )
|
||||
|
||||
M: array condomize [ condomize ] map ;
|
||||
|
||||
M: callable condomize [ condomize ] map ;
|
||||
|
||||
M: object condomize ;
|
||||
|
||||
: literal ( obj -- ) dup condomize? [ condomize ] when stack get push ;
|
||||
|
||||
GENERIC: expand-macros* ( obj -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -139,8 +139,8 @@ HELP: flags
|
|||
{ $examples
|
||||
{ $example "USING: math.bitwise kernel prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
": MY-CONSTANT HEX: 1 ; inline"
|
||||
"{ HEX: 20 MY-CONSTANT BIN: 100 } flags .h"
|
||||
"CONSTANT: x HEX: 1"
|
||||
"{ HEX: 20 x BIN: 100 } flags .h"
|
||||
"25"
|
||||
}
|
||||
} ;
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg.
|
||||
! Copyright (C) 2007, 2009 Slava Pestov, Daniel Ehrenberg.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.syntax help.markup ;
|
||||
USING: help.syntax help.markup words quotations effects ;
|
||||
IN: memoize
|
||||
|
||||
HELP: define-memoized
|
||||
{ $values { "word" "the word to be defined" } { "quot" "a quotation" } }
|
||||
{ $values { "word" word } { "quot" quotation } { "effect" effect } }
|
||||
{ $description "defines the given word at runtime as one which memoizes its output given a particular input" }
|
||||
{ $notes "A maximum of four input and four output arguments can be used" }
|
||||
{ $see-also POSTPONE: MEMO: } ;
|
||||
|
|
|
|||
|
|
@ -9,14 +9,14 @@ TUPLE: just-parser p1 ;
|
|||
|
||||
CONSTANT: just-pattern
|
||||
[
|
||||
execute dup [
|
||||
dup [
|
||||
dup remaining>> empty? [ drop f ] unless
|
||||
] when
|
||||
]
|
||||
|
||||
|
||||
M: just-parser (compile) ( parser -- quot )
|
||||
p1>> compile-parser just-pattern curry ;
|
||||
p1>> compile-parser-quot just-pattern compose ;
|
||||
|
||||
: just ( parser -- parser )
|
||||
just-parser boa wrap-peg ;
|
||||
|
|
|
|||
|
|
@ -116,7 +116,7 @@ TUPLE: peg-head rule-id involved-set eval-set ;
|
|||
#! Evaluate a rule, return an ast resulting from it.
|
||||
#! Return fail if the rule failed. The rule has
|
||||
#! stack effect ( -- parse-result )
|
||||
pos get swap execute process-rule-result ; inline
|
||||
pos get swap execute( -- parse-result ) process-rule-result ; inline
|
||||
|
||||
: memo ( pos id -- memo-entry )
|
||||
#! Return the result from the memo cache.
|
||||
|
|
@ -244,14 +244,15 @@ TUPLE: peg-head rule-id involved-set eval-set ;
|
|||
|
||||
: with-packrat ( input quot -- result )
|
||||
#! Run the quotation with a packrat cache active.
|
||||
swap [
|
||||
input set
|
||||
[
|
||||
swap input set
|
||||
0 pos set
|
||||
f lrstack set
|
||||
V{ } clone error-stack set
|
||||
H{ } clone \ heads set
|
||||
H{ } clone \ packrat set
|
||||
] H{ } make-assoc swap bind ; inline
|
||||
call
|
||||
] with-scope ; inline
|
||||
|
||||
|
||||
GENERIC: (compile) ( peg -- quot )
|
||||
|
|
@ -264,20 +265,16 @@ GENERIC: (compile) ( peg -- quot )
|
|||
] if ;
|
||||
|
||||
: execute-parser ( word -- result )
|
||||
pos get apply-rule process-parser-result ; inline
|
||||
|
||||
: parser-body ( parser -- quot )
|
||||
#! Return the body of the word that is the compiled version
|
||||
#! of the parser.
|
||||
gensym 2dup swap peg>> (compile) (( -- result )) define-declared
|
||||
swap dupd id>> "peg-id" set-word-prop
|
||||
[ execute-parser ] curry ;
|
||||
pos get apply-rule process-parser-result ;
|
||||
|
||||
: preset-parser-word ( parser -- parser word )
|
||||
gensym [ >>compiled ] keep ;
|
||||
|
||||
: define-parser-word ( parser word -- )
|
||||
swap parser-body (( -- result )) define-declared ;
|
||||
#! Return the body of the word that is the compiled version
|
||||
#! of the parser.
|
||||
2dup swap peg>> (compile) (( -- result )) define-declared
|
||||
swap id>> "peg-id" set-word-prop ;
|
||||
|
||||
: compile-parser ( parser -- word )
|
||||
#! Look to see if the given parser has been compiled.
|
||||
|
|
@ -292,19 +289,22 @@ GENERIC: (compile) ( peg -- quot )
|
|||
preset-parser-word [ define-parser-word ] keep
|
||||
] if* ;
|
||||
|
||||
: compile-parser-quot ( parser -- quot )
|
||||
compile-parser [ execute-parser ] curry ;
|
||||
|
||||
SYMBOL: delayed
|
||||
|
||||
: fixup-delayed ( -- )
|
||||
#! Work through all delayed parsers and recompile their
|
||||
#! words to have the correct bodies.
|
||||
delayed get [
|
||||
call( -- parser ) compile-parser 1quotation (( -- result )) define-declared
|
||||
call( -- parser ) compile-parser-quot (( -- result )) define-declared
|
||||
] assoc-each ;
|
||||
|
||||
: compile ( parser -- word )
|
||||
[
|
||||
H{ } clone delayed [
|
||||
compile-parser fixup-delayed
|
||||
compile-parser-quot (( -- result )) define-temp fixup-delayed
|
||||
] with-variable
|
||||
] with-compilation-unit ;
|
||||
|
||||
|
|
@ -411,8 +411,8 @@ M: seq-parser (compile) ( peg -- quot )
|
|||
[
|
||||
[ input-slice V{ } clone <parse-result> ] %
|
||||
[
|
||||
parsers>> unclip compile-parser 1quotation [ parse-seq-element ] curry ,
|
||||
[ compile-parser 1quotation [ merge-errors ] compose [ parse-seq-element ] curry , ] each
|
||||
parsers>> unclip compile-parser-quot [ parse-seq-element ] curry ,
|
||||
[ compile-parser-quot [ merge-errors ] compose [ parse-seq-element ] curry , ] each
|
||||
] { } make , \ 1&& ,
|
||||
] [ ] make ;
|
||||
|
||||
|
|
@ -421,8 +421,8 @@ TUPLE: choice-parser parsers ;
|
|||
M: choice-parser (compile) ( peg -- quot )
|
||||
[
|
||||
[
|
||||
parsers>> [ compile-parser ] map
|
||||
unclip 1quotation , [ 1quotation [ merge-errors ] compose , ] each
|
||||
parsers>> [ compile-parser-quot ] map
|
||||
unclip , [ [ merge-errors ] compose , ] each
|
||||
] { } make , \ 0|| ,
|
||||
] [ ] make ;
|
||||
|
||||
|
|
@ -438,7 +438,7 @@ TUPLE: repeat0-parser p1 ;
|
|||
] if* ; inline recursive
|
||||
|
||||
M: repeat0-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[
|
||||
p1>> compile-parser-quot '[
|
||||
input-slice V{ } clone <parse-result> _ swap (repeat)
|
||||
] ;
|
||||
|
||||
|
|
@ -452,7 +452,7 @@ TUPLE: repeat1-parser p1 ;
|
|||
] if* ;
|
||||
|
||||
M: repeat1-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[
|
||||
p1>> compile-parser-quot '[
|
||||
input-slice V{ } clone <parse-result> _ swap (repeat) repeat1-empty-check
|
||||
] ;
|
||||
|
||||
|
|
@ -462,7 +462,7 @@ TUPLE: optional-parser p1 ;
|
|||
[ input-slice f <parse-result> ] unless* ;
|
||||
|
||||
M: optional-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[ @ check-optional ] ;
|
||||
p1>> compile-parser-quot '[ @ check-optional ] ;
|
||||
|
||||
TUPLE: semantic-parser p1 quot ;
|
||||
|
||||
|
|
@ -474,7 +474,7 @@ TUPLE: semantic-parser p1 quot ;
|
|||
] if ; inline
|
||||
|
||||
M: semantic-parser (compile) ( peg -- quot )
|
||||
[ p1>> compile-parser 1quotation ] [ quot>> ] bi
|
||||
[ p1>> compile-parser-quot ] [ quot>> ] bi
|
||||
'[ @ _ check-semantic ] ;
|
||||
|
||||
TUPLE: ensure-parser p1 ;
|
||||
|
|
@ -483,7 +483,7 @@ TUPLE: ensure-parser p1 ;
|
|||
[ ignore <parse-result> ] [ drop f ] if ;
|
||||
|
||||
M: ensure-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[ input-slice @ check-ensure ] ;
|
||||
p1>> compile-parser-quot '[ input-slice @ check-ensure ] ;
|
||||
|
||||
TUPLE: ensure-not-parser p1 ;
|
||||
|
||||
|
|
@ -491,7 +491,7 @@ TUPLE: ensure-not-parser p1 ;
|
|||
[ drop f ] [ ignore <parse-result> ] if ;
|
||||
|
||||
M: ensure-not-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[ input-slice @ check-ensure-not ] ;
|
||||
p1>> compile-parser-quot '[ input-slice @ check-ensure-not ] ;
|
||||
|
||||
TUPLE: action-parser p1 quot ;
|
||||
|
||||
|
|
@ -503,12 +503,12 @@ TUPLE: action-parser p1 quot ;
|
|||
] if ; inline
|
||||
|
||||
M: action-parser (compile) ( peg -- quot )
|
||||
[ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ _ check-action ] ;
|
||||
[ p1>> compile-parser-quot ] [ quot>> ] bi '[ @ _ check-action ] ;
|
||||
|
||||
TUPLE: sp-parser p1 ;
|
||||
|
||||
M: sp-parser (compile) ( peg -- quot )
|
||||
p1>> compile-parser 1quotation '[
|
||||
p1>> compile-parser-quot '[
|
||||
input-slice [ blank? ] trim-head-slice input-from pos set @
|
||||
] ;
|
||||
|
||||
|
|
@ -527,7 +527,7 @@ M: box-parser (compile) ( peg -- quot )
|
|||
#! to produce the parser to be compiled.
|
||||
#! This differs from 'delay' which calls
|
||||
#! it at run time.
|
||||
quot>> call( -- parser ) compile-parser 1quotation ;
|
||||
quot>> call( -- parser ) compile-parser-quot ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
|
|
|||
|
|
@ -37,14 +37,14 @@ HELP: key-ref
|
|||
{ $class-description "Instances of this class identify a key in an associative structure. New key references are created by calling " { $link <key-ref> } "." } ;
|
||||
|
||||
HELP: <key-ref>
|
||||
{ $values { "key" object } { "assoc" "an assoc" } { "ref" key-ref } }
|
||||
{ $values { "assoc" "an assoc" } { "key" object } { "key-ref" key-ref } }
|
||||
{ $description "Creates a reference to a key stored in an assoc." } ;
|
||||
|
||||
HELP: value-ref
|
||||
{ $class-description "Instances of this class identify a value associated to a key in an associative structure. New value references are created by calling " { $link <value-ref> } "." } ;
|
||||
|
||||
HELP: <value-ref>
|
||||
{ $values { "key" object } { "assoc" "an assoc" } { "ref" value-ref } }
|
||||
{ $values { "assoc" "an assoc" } { "key" object } { "value-ref" value-ref } }
|
||||
{ $description "Creates a reference to the value associated with " { $snippet "key" } " in " { $snippet "assoc" } "." } ;
|
||||
|
||||
{ get-ref set-ref delete-ref } related-words
|
||||
|
|
|
|||
|
|
@ -12,11 +12,11 @@ GENERIC: get-ref ( ref -- obj )
|
|||
GENERIC: set-ref ( obj ref -- )
|
||||
|
||||
TUPLE: key-ref < ref ;
|
||||
C: <key-ref> key-ref ( assoc key -- ref )
|
||||
C: <key-ref> key-ref
|
||||
M: key-ref get-ref key>> ;
|
||||
M: key-ref set-ref >ref< rename-at ;
|
||||
|
||||
TUPLE: value-ref < ref ;
|
||||
C: <value-ref> value-ref ( assoc key -- ref )
|
||||
C: <value-ref> value-ref
|
||||
M: value-ref get-ref >ref< at ;
|
||||
M: value-ref set-ref >ref< set-at ;
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ HELP: definer
|
|||
{ $examples
|
||||
{ $example "USING: definitions prettyprint ;"
|
||||
"IN: scratchpad"
|
||||
": foo ; \\ foo definer . ."
|
||||
": foo ( -- ) ; \\ foo definer . ."
|
||||
";\nPOSTPONE: :"
|
||||
}
|
||||
{ $example "USING: definitions prettyprint ;"
|
||||
|
|
@ -50,6 +50,9 @@ $nl
|
|||
"Printing a definition:"
|
||||
{ $subsection see }
|
||||
"Printing the methods defined on a generic word or class (see " { $link "objects" } "):"
|
||||
{ $subsection see-methods } ;
|
||||
{ $subsection see-methods }
|
||||
"Definition specifiers implementing the " { $link "definition-protocol" } " should also implement the " { $emphasis "see protocol" } ":"
|
||||
{ $subsection see* }
|
||||
{ $subsection synopsis* } ;
|
||||
|
||||
ABOUT: "see"
|
||||
|
|
@ -10,6 +10,8 @@ prettyprint.sections sequences sets sorting strings summary
|
|||
words words.symbol ;
|
||||
IN: see
|
||||
|
||||
GENERIC: synopsis* ( defspec -- )
|
||||
|
||||
GENERIC: see* ( defspec -- )
|
||||
|
||||
: see ( defspec -- ) see* nl ;
|
||||
|
|
|
|||
|
|
@ -33,9 +33,9 @@ $nl
|
|||
"A general rule of thumb is that any word which applies " { $link call } " or " { $link curry } " to one of its inputs must be declared " { $link POSTPONE: inline } "."
|
||||
$nl
|
||||
"Here is an example where the stack effect cannot be inferred:"
|
||||
{ $code ": foo 0 [ + ] ;" "[ foo reduce ] infer." }
|
||||
{ $code ": foo ( -- n quot ) 0 [ + ] ;" "[ foo reduce ] infer." }
|
||||
"However if " { $snippet "foo" } " was declared " { $link POSTPONE: inline } ", everything would work, since the " { $link reduce } " combinator is also " { $link POSTPONE: inline } ", and the inferencer can see the literal quotation value at the point it is passed to " { $link call } ":"
|
||||
{ $example ": foo 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
|
||||
{ $example ": foo ( -- n quot ) 0 [ + ] ; inline" "[ foo reduce ] infer." "( object -- object )" }
|
||||
"Passing a literal quotation on the data stack through an inlined recursive combinator nullifies its literal status. For example, the following will not infer:"
|
||||
{ $example
|
||||
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected\n\nType :help for debugging help."
|
||||
|
|
|
|||
|
|
@ -292,7 +292,7 @@ DEFER: bar
|
|||
|
||||
[ [ [ m ] m ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
: m' dup curry call ; inline
|
||||
: m' ( quot -- ) dup curry call ; inline
|
||||
|
||||
[ [ [ m' ] m' ] infer ] [ inference-error? ] must-fail-with
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
IN: tools.apropos.tests
|
||||
USING: tools.apropos tools.test ;
|
||||
|
||||
[ ] [ "swp" apropos ] unit-test
|
||||
|
|
@ -204,7 +204,8 @@ IN: tools.deploy.shaker
|
|||
] when ;
|
||||
|
||||
: strip-vocab-globals ( except names -- words )
|
||||
[ child-vocabs [ words ] map concat ] map concat swap diff ;
|
||||
[ child-vocabs [ words ] map concat ] map concat
|
||||
swap [ first2 lookup ] map sift diff ;
|
||||
|
||||
: stripped-globals ( -- seq )
|
||||
[
|
||||
|
|
@ -245,7 +246,8 @@ IN: tools.deploy.shaker
|
|||
strip-dictionary? [
|
||||
"libraries" "alien" lookup ,
|
||||
|
||||
{ } { "cpu" "compiler" } strip-vocab-globals %
|
||||
{ { "yield-hook" "compiler.utilities" } }
|
||||
{ "cpu" "compiler" } strip-vocab-globals %
|
||||
|
||||
{
|
||||
gensym
|
||||
|
|
|
|||
|
|
@ -1,5 +0,0 @@
|
|||
IN: tools.vocabs.browser.tests
|
||||
USING: tools.vocabs.browser tools.test help.markup help vocabs ;
|
||||
|
||||
[ ] [ { $vocab "scratchpad" } print-content ] unit-test
|
||||
[ ] [ "classes" vocab print-topic ] unit-test
|
||||
|
|
@ -354,7 +354,7 @@ H{ } clone wm-handlers set-global
|
|||
|
||||
: add-wm-handler ( quot wm -- )
|
||||
dup array?
|
||||
[ [ execute add-wm-handler ] with each ]
|
||||
[ [ execute( -- wm ) add-wm-handler ] with each ]
|
||||
[ wm-handlers get-global set-at ] if ;
|
||||
|
||||
[ handle-wm-close 0 ] WM_CLOSE add-wm-handler
|
||||
|
|
|
|||
|
|
@ -54,7 +54,7 @@ HELP: command-name
|
|||
{ $example
|
||||
"USING: io ui.commands ;"
|
||||
"IN: scratchpad"
|
||||
": com-my-command ;"
|
||||
": com-my-command ( -- ) ;"
|
||||
"\\ com-my-command command-name write"
|
||||
"My Command"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: documents help.markup help.syntax ui.gadgets
|
||||
ui.gadgets.scrollers models strings ui.commands
|
||||
ui.text colors fonts ;
|
||||
ui.text colors fonts help.tips ;
|
||||
IN: ui.gadgets.editors
|
||||
|
||||
HELP: editor
|
||||
|
|
@ -109,4 +109,8 @@ ARTICLE: "ui.gadgets.editors" "Editor gadgets"
|
|||
"Editors edit " { $emphasis "documents" } ":"
|
||||
{ $subsection "documents" } ;
|
||||
|
||||
TIP: "Editor gadgets support undo and redo; press " { $command editor "editing" com-undo } " and " { $command editor "editing" com-redo } "." ;
|
||||
|
||||
TIP: "Learn the keyboard shortcuts used in " { $link "ui.gadgets.editors" } "." ;
|
||||
|
||||
ABOUT: "ui.gadgets.editors"
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: debugger help help.topics help.crossref kernel models compiler.units
|
||||
assocs words vocabs accessors fry combinators.short-circuit
|
||||
sequences models models.history tools.apropos combinators
|
||||
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
|
||||
USING: debugger help help.topics help.crossref help.home kernel
|
||||
models compiler.units assocs words vocabs accessors fry
|
||||
combinators.short-circuit namespaces sequences models
|
||||
models.history help.apropos combinators ui.commands ui.gadgets
|
||||
ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
|
||||
ui.gestures ui.gadgets.buttons ui.gadgets.packs
|
||||
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
|
||||
ui.gadgets.glass ui.gadgets.borders ui.tools.common
|
||||
ui.tools.browser.popups ui ;
|
||||
|
|
@ -15,8 +16,8 @@ TUPLE: browser-gadget < tool pane scroller search-field popup ;
|
|||
{ 650 400 } browser-gadget set-tool-dim
|
||||
|
||||
: show-help ( link browser-gadget -- )
|
||||
model>> dup add-history
|
||||
[ >link ] dip set-model ;
|
||||
[ >link ] [ model>> ] bi*
|
||||
[ [ add-recent ] [ add-history ] bi* ] [ set-model ] 2bi ;
|
||||
|
||||
: <help-pane> ( browser-gadget -- gadget )
|
||||
model>> [ '[ _ print-topic ] try ] <pane-control> ;
|
||||
|
|
@ -96,7 +97,7 @@ M: browser-gadget focusable-child* search-field>> ;
|
|||
|
||||
: com-forward ( browser -- ) model>> go-forward ;
|
||||
|
||||
: com-documentation ( browser -- ) "handbook" swap show-help ;
|
||||
: com-documentation ( browser -- ) "help.home" swap show-help ;
|
||||
|
||||
: browser-help ( -- ) "ui-browser" com-browse ;
|
||||
|
||||
|
|
@ -113,7 +114,7 @@ browser-gadget "toolbar" f {
|
|||
over [ show-help ] [ 2drop ] if ;
|
||||
|
||||
: navigate ( browser quot -- )
|
||||
'[ control-value @ ] keep ?show-help ;
|
||||
'[ control-value @ ] keep ?show-help ; inline
|
||||
|
||||
: com-up ( browser -- ) [ article-parent ] navigate ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
USING: help.markup help.syntax ;
|
||||
USING: help.markup help.syntax help.tips ;
|
||||
IN: ui.tools.deploy
|
||||
|
||||
HELP: deploy-tool
|
||||
|
|
@ -14,4 +14,6 @@ $nl
|
|||
"Alternatively, right-click on a vocabulary presentation in the UI and choose " { $strong "Deploy tool" } " from the resulting popup menu."
|
||||
{ $see-also "tools.deploy" } ;
|
||||
|
||||
TIP: "Generate stand-alone applications from vocabularies with the " { $link "ui.tools.deploy" } "." ;
|
||||
|
||||
ABOUT: "ui.tools.deploy"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors arrays assocs calendar colors colors.constants
|
||||
documents documents.elements fry kernel words sets splitting math
|
||||
math.vectors models.delay models.arrow combinators.short-circuit
|
||||
parser present sequences tools.completion tools.vocabs.browser generic
|
||||
parser present sequences tools.completion help.vocabs generic
|
||||
generic.standard.engines.tuple fonts definitions.icons ui.images
|
||||
ui.commands ui.operations ui.gadgets ui.gadgets.editors
|
||||
ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables
|
||||
|
|
|
|||
|
|
@ -1,5 +1,7 @@
|
|||
USING: help.markup help.syntax ui.commands ui.operations
|
||||
ui.gadgets.editors ui.gadgets.panes listener io words ;
|
||||
ui.gadgets.editors ui.gadgets.panes listener io words
|
||||
ui.tools.listener.completion ui.tools.common help.tips
|
||||
tools.vocabs vocabs ;
|
||||
IN: ui.tools.listener
|
||||
|
||||
HELP: interactor
|
||||
|
|
@ -21,11 +23,27 @@ ARTICLE: "ui-listener" "UI listener"
|
|||
{ $operations \ word }
|
||||
{ $heading "Vocabulary commands" }
|
||||
"These words operate on the vocabulary at the cursor."
|
||||
{ $operations \ word }
|
||||
{ $operations T{ vocab-link f "kernel" } }
|
||||
{ $command-map interactor "quotation" }
|
||||
{ $heading "Editing commands" }
|
||||
"The text editing commands are standard; see " { $link "gadgets-editors-commands" } "."
|
||||
{ $heading "Implementation" }
|
||||
"Listeners are instances of " { $link listener-gadget } ". The listener consists of an output area (instance of " { $link pane } ") and an input area (instance of " { $link interactor } "). Clickable presentations can also be printed to the listener; see " { $link "ui-presentations" } "." ;
|
||||
|
||||
TIP: "You can read documentation by pressing F1." ;
|
||||
|
||||
TIP: "The listener tool remembers previous lines of input. Press " { $command interactor "completion" recall-previous } " and " { $command interactor "completion" recall-next } " to cycle through them." ;
|
||||
|
||||
TIP: "When you mouse over certain objects, a block border will appear. Left-clicking on such an object will perform the default operation. Right-clicking will show a menu with all operations." ;
|
||||
|
||||
TIP: "The status bar displays stack effects of recognized words as they are being typed in." ;
|
||||
|
||||
TIP: "Press " { $command interactor "completion" code-completion-popup } " to complete word, vocabulary and Unicode character names. The latter two features become available if the cursor is after a " { $link POSTPONE: USE: } ", " { $link POSTPONE: USING: } " or " { $link POSTPONE: CHAR: } "." ;
|
||||
|
||||
TIP: "If a word's vocabulary is loaded, but not in the search path, you can use restarts to add the vocabulary to the search path. Auto-use mode (" { $command listener-gadget "toolbar" com-auto-use } ") invokes restarts automatically if there is only one restart." ;
|
||||
|
||||
TIP: "Scroll the listener from the keyboard by pressing " { $command listener-gadget "scrolling" com-page-up } " and " { $command listener-gadget "scrolling" com-page-down } "." ;
|
||||
|
||||
TIP: "Press " { $command tool "common" refresh-all } " or run " { $link refresh-all } " to reload changed source files from disk. " ;
|
||||
|
||||
ABOUT: "ui-listener"
|
||||
|
|
@ -2,12 +2,13 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs calendar combinators locals
|
||||
colors.constants combinators.short-circuit compiler.units
|
||||
concurrency.flags concurrency.mailboxes continuations destructors
|
||||
documents documents.elements fry hashtables help help.markup io
|
||||
io.styles kernel lexer listener math models models.delay models.arrow
|
||||
namespaces parser prettyprint quotations sequences strings threads
|
||||
tools.vocabs vocabs vocabs.loader vocabs.parser words debugger ui ui.commands
|
||||
ui.pens.solid ui.gadgets ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
|
||||
help.tips concurrency.flags concurrency.mailboxes continuations
|
||||
destructors documents documents.elements fry hashtables help
|
||||
help.markup io io.styles kernel lexer listener math models
|
||||
models.delay models.arrow namespaces parser prettyprint quotations
|
||||
sequences strings threads tools.vocabs vocabs vocabs.loader
|
||||
vocabs.parser words debugger ui ui.commands ui.pens.solid ui.gadgets
|
||||
ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
|
||||
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
|
||||
ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.borders ui.gestures
|
||||
ui.operations ui.tools.browser ui.tools.common ui.tools.debugger
|
||||
|
|
@ -354,16 +355,11 @@ interactor "completion" f {
|
|||
{ T{ key-down f { C+ } "r" } history-completion-popup }
|
||||
} define-command-map
|
||||
|
||||
: welcome. ( -- )
|
||||
"If this is your first time with Factor, please read the " print
|
||||
"handbook" ($link) ". To see a list of keyboard shortcuts," print
|
||||
"press F1." print nl ;
|
||||
|
||||
: listener-thread ( listener -- )
|
||||
dup listener-streams [
|
||||
[ com-browse ] help-hook set
|
||||
'[ [ _ input>> ] 2dip debugger-popup ] error-hook set
|
||||
welcome.
|
||||
tip-of-the-day. nl
|
||||
listener
|
||||
] with-streams* ;
|
||||
|
||||
|
|
@ -385,7 +381,7 @@ interactor "completion" f {
|
|||
[ wait-for-listener ]
|
||||
} cleave ;
|
||||
|
||||
: listener-help ( -- ) "ui-listener" com-browse ;
|
||||
: listener-help ( -- ) "help.home" com-browse ;
|
||||
|
||||
\ listener-help H{ { +nullary+ t } } define-command
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,8 @@
|
|||
USING: help.tips help.markup help.syntax ui.operations
|
||||
tools.walker tools.time tools.profiler ui.tools.operations ;
|
||||
|
||||
TIP: "Press " { $operation com-stack-effect } " to print the stack effect of the code in the input field without executing it (" { $link "inference" } ")." ;
|
||||
|
||||
TIP: "Press " { $operation walk } " to single-step through the code in the input field (" { $link "ui-walker" } ")." ;
|
||||
|
||||
TIP: "Press " { $operation time } " to time execution of the code in the input field (" { $link "timing" } ")." ;
|
||||
|
|
@ -9,7 +9,7 @@ compiler.units accessors vocabs.parser macros.expander ui
|
|||
ui.tools.browser ui.tools.listener ui.tools.listener.completion
|
||||
ui.tools.profiler ui.tools.inspector ui.tools.traceback
|
||||
ui.commands ui.gadgets.editors ui.gestures ui.operations
|
||||
ui.tools.deploy models ;
|
||||
ui.tools.deploy models help.tips ;
|
||||
IN: ui.tools.operations
|
||||
|
||||
! Objects
|
||||
|
|
@ -157,8 +157,6 @@ M: word com-stack-effect 1quotation com-stack-effect ;
|
|||
{ +listener+ t }
|
||||
} define-operation
|
||||
|
||||
: com-profile ( quot -- ) profile profiler-window ;
|
||||
|
||||
[ quotation? ] \ com-profile H{
|
||||
{ +keyboard+ T{ key-down f { C+ } "o" } }
|
||||
{ +listener+ t }
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
IN: ui.tools.profiler
|
||||
USING: help.markup help.syntax ui.operations help.tips ;
|
||||
|
||||
ARTICLE: "ui.tools.profiler" "UI profiler tool"
|
||||
"The " { $vocab-link "ui.tools.profiler" } " vocabulary implements a graphical tool for viewing profiling results (see " { $link "profiling" } ")."
|
||||
$nl
|
||||
"To use the profiler, enter a piece of code in the listener's input area and press " { $operation com-profile } "." ;
|
||||
|
||||
TIP: "Press " { $operation com-profile } " to run the code in the input field with profiling enabled (" { $link "ui.tools.profiler" } ")." ;
|
||||
|
||||
ABOUT: "ui.tools.profiler"
|
||||
|
|
@ -208,4 +208,6 @@ profiler-gadget "toolbar" f {
|
|||
: profiler-window ( -- )
|
||||
<profiler-gadget> "Profiling results" open-status-window ;
|
||||
|
||||
: com-profile ( quot -- ) profile profiler-window ;
|
||||
|
||||
MAIN: profiler-window
|
||||
|
|
@ -1,7 +1,8 @@
|
|||
USING: editors help.markup help.syntax summary inspector io io.styles
|
||||
listener parser prettyprint tools.profiler tools.walker ui.commands
|
||||
ui.gadgets.panes ui.gadgets.presentations ui.operations
|
||||
ui.tools.operations ui.tools.profiler ui.tools.common vocabs see ;
|
||||
ui.tools.operations ui.tools.profiler ui.tools.common vocabs see
|
||||
help.tips ;
|
||||
IN: ui.tools
|
||||
|
||||
ARTICLE: "starting-ui-tools" "Starting the UI tools"
|
||||
|
|
@ -67,4 +68,6 @@ $nl
|
|||
"Platform-specific features:"
|
||||
{ $subsection "ui-cocoa" } ;
|
||||
|
||||
TIP: "All UI developer tools support a common set of " { $link "ui-shortcuts" } ". Each individual tool has its own shortcuts as well; the F1 key is context-sensitive." ;
|
||||
|
||||
ABOUT: "ui-tools"
|
||||
|
|
|
|||
|
|
@ -832,7 +832,7 @@ SYMBOLS:
|
|||
define-keyboard-format-constant
|
||||
define-hid-keyboard-format-constant ;
|
||||
|
||||
: define-constants
|
||||
: define-constants ( -- )
|
||||
define-guid-constants
|
||||
define-format-constants ;
|
||||
|
||||
|
|
|
|||
|
|
@ -27,15 +27,15 @@ TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW
|
|||
[ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ]
|
||||
dip alien-callback ; inline
|
||||
TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
|
||||
: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
|
||||
: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK ( quot -- callback )
|
||||
[ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ]
|
||||
dip alien-callback ; inline
|
||||
TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK
|
||||
: LPDIENUMEFFECTSINFILECALLBACK
|
||||
: LPDIENUMEFFECTSINFILECALLBACK ( quot -- callback )
|
||||
[ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ]
|
||||
dip alien-callback ; inline
|
||||
TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW
|
||||
: LPDIENUMDEVICEOBJECTSCALLBACKW
|
||||
: LPDIENUMDEVICEOBJECTSCALLBACKW ( quot -- callback )
|
||||
[ "BOOL" { "LPCDIDEVICEOBJECTINSTANCEW" "LPVOID" } "stdcall" ]
|
||||
dip alien-callback ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -142,7 +142,7 @@ check_X11_libraries() {
|
|||
check_library_exists GLU
|
||||
check_library_exists GL
|
||||
check_library_exists X11
|
||||
check_library_exists pango
|
||||
check_library_exists pango-1.0
|
||||
}
|
||||
|
||||
check_libraries() {
|
||||
|
|
|
|||
|
|
@ -13,9 +13,9 @@ $nl
|
|||
"Definitions can answer a sequence of definitions they directly depend on:"
|
||||
{ $subsection uses }
|
||||
"Definitions must implement a few operations used for printing them in source form:"
|
||||
{ $subsection synopsis* }
|
||||
{ $subsection definer }
|
||||
{ $subsection definition } ;
|
||||
{ $subsection definition }
|
||||
{ $see-also "see" } ;
|
||||
|
||||
ARTICLE: "definition-crossref" "Definition cross referencing"
|
||||
"A common cross-referencing system is used to track definition usages:"
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ ARTICLE: "method-combination" "Custom method combination"
|
|||
{ { $link POSTPONE: HOOK: } { $link hook-combination } }
|
||||
{ { $link POSTPONE: MATH: } { $link math-combination } }
|
||||
}
|
||||
"Developing a custom method combination requires that a parsing word calling " { $link define-generic } " be defined; additionally, it is a good idea to implement the definition protocol words " { $link definer } " and " { $link synopsis* } " on the class of words having this method combination, to properly support developer tools."
|
||||
"Developing a custom method combination requires that a parsing word calling " { $link define-generic } " be defined; additionally, it is a good idea to implement the " { $link "definition-protocol" } " on the class of words having this method combination, to properly support developer tools."
|
||||
$nl
|
||||
"The combination quotation passed to " { $link define-generic } " has stack effect " { $snippet "( word -- quot )" } ". It's job is to call various introspection words, including at least obtaining the set of methods defined on the generic word, then combining these methods in some way to produce a quotation."
|
||||
{ $see-also "generic-introspection" } ;
|
||||
|
|
|
|||
|
|
@ -307,7 +307,7 @@ HELP: find-last-integer
|
|||
{ $notes "This word is used to implement " { $link find-last } "." } ;
|
||||
|
||||
HELP: byte-array>bignum
|
||||
{ $values { "byte-array" byte-array } { "n" integer } }
|
||||
{ $values { "x" byte-array } { "y" bignum } }
|
||||
{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ;
|
||||
|
||||
ARTICLE: "division-by-zero" "Division by zero"
|
||||
|
|
|
|||
|
|
@ -15,9 +15,9 @@ IN: memory.tests
|
|||
[ [ ] instances ] must-infer
|
||||
|
||||
! Code GC wasn't kicking in when needed
|
||||
: leak-step 800000 f <array> 1quotation call drop ;
|
||||
: leak-step ( -- ) 800000 f <array> 1quotation call drop ;
|
||||
|
||||
: leak-loop 100 [ leak-step ] times ;
|
||||
: leak-loop ( -- ) 100 [ leak-step ] times ;
|
||||
|
||||
[ ] [ leak-loop ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -166,6 +166,7 @@ SYMBOL: interactive-vocabs
|
|||
"definitions"
|
||||
"editors"
|
||||
"help"
|
||||
"help.apropos"
|
||||
"help.lint"
|
||||
"inspector"
|
||||
"io"
|
||||
|
|
@ -186,7 +187,6 @@ SYMBOL: interactive-vocabs
|
|||
"strings"
|
||||
"syntax"
|
||||
"tools.annotations"
|
||||
"tools.apropos"
|
||||
"tools.crossref"
|
||||
"tools.disassembler"
|
||||
"tools.memory"
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: arrays byte-arrays help.markup help.syntax
|
||||
kernel kernel.private strings.private sequences vectors
|
||||
sbufs math tools.vocabs.browser ;
|
||||
sbufs math help.vocabs ;
|
||||
IN: strings
|
||||
|
||||
ARTICLE: "strings" "Strings"
|
||||
|
|
@ -26,17 +26,17 @@ ABOUT: "strings"
|
|||
HELP: string
|
||||
{ $description "The class of fixed-length character strings. See " { $link "syntax-strings" } " for syntax and " { $link "strings" } " for general information." } ;
|
||||
|
||||
HELP: string-nth ( n string -- ch )
|
||||
HELP: string-nth
|
||||
{ $values { "n" fixnum } { "string" string } { "ch" "the character at the " { $snippet "n" } "th index" } }
|
||||
{ $description "Unsafe string accessor, used to define " { $link nth } " on strings." }
|
||||
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link nth } " instead." } ;
|
||||
|
||||
HELP: set-string-nth ( ch n string -- )
|
||||
HELP: set-string-nth
|
||||
{ $values { "ch" "a character" } { "n" fixnum } { "string" string } }
|
||||
{ $description "Unsafe string mutator, used to define " { $link set-nth } " on strings." }
|
||||
{ $warning "This word is in the " { $vocab-link "strings.private" } " vocabulary because it does not perform type or bounds checking. User code should call " { $link set-nth } " instead." } ;
|
||||
|
||||
HELP: <string> ( n ch -- string )
|
||||
HELP: <string>
|
||||
{ $values { "n" "a positive integer specifying string length" } { "ch" "an initial character" } { "string" string } }
|
||||
{ $description "Creates a new string with the given length and all characters initially set to " { $snippet "ch" } "." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ IN: strings
|
|||
: rehash-string ( str -- )
|
||||
1 over sequence-hashcode swap set-string-hashcode ; inline
|
||||
|
||||
: set-string-nth ( ch n str -- )
|
||||
: set-string-nth ( ch n string -- )
|
||||
pick HEX: 7f fixnum<=
|
||||
[ set-string-nth-fast ] [ set-string-nth-slow ] if ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -180,7 +180,7 @@ HELP: delimiter
|
|||
HELP: SYNTAX:
|
||||
{ $syntax "SYNTAX: foo ... ;" }
|
||||
{ $description "Defines a parsing word." }
|
||||
{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world HELLO ;" "Hello parser!" } } ;
|
||||
{ $examples "In the below example, the " { $snippet "world" } " word is never called, however its body references a parsing word which executes immediately:" { $example "USE: io" "IN: scratchpad" "<< SYNTAX: HELLO \"Hello parser!\" print ; >>\n: world ( -- ) HELLO ;" "Hello parser!" } } ;
|
||||
|
||||
HELP: inline
|
||||
{ $syntax ": foo ... ; inline" }
|
||||
|
|
|
|||
|
|
@ -165,7 +165,7 @@ HELP: execute ( word -- )
|
|||
{ $values { "word" word } }
|
||||
{ $description "Executes a word." }
|
||||
{ $examples
|
||||
{ $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
|
||||
{ $example "USING: kernel io words ;" "IN: scratchpad" ": twice ( word -- ) dup execute execute ;\n: hello ( -- ) \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
|
||||
} ;
|
||||
|
||||
HELP: deferred
|
||||
|
|
@ -273,8 +273,8 @@ HELP: bootstrap-word
|
|||
{ $values { "word" word } { "target" word } }
|
||||
{ $description "Looks up a word with the same name and vocabulary as the given word, performing a transformation to handle parsing words in the target dictionary. Used during bootstrap to transfer host words to the target dictionary." } ;
|
||||
|
||||
HELP: parsing-word? ( obj -- ? )
|
||||
{ $values { "obj" object } { "?" "a boolean" } }
|
||||
HELP: parsing-word?
|
||||
{ $values { "object" object } { "?" "a boolean" } }
|
||||
{ $description "Tests if an object is a parsing word declared by " { $link POSTPONE: SYNTAX: } "." }
|
||||
{ $notes "Outputs " { $link f } " if the object is not a word." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ DEFER: check-status
|
|||
[ dup quit? [ quit-game ] [ repeat ] if ]
|
||||
if ;
|
||||
: build-quad ( -- array ) 4 [ 10 random ] replicate >array ;
|
||||
: 24-able? ( vector -- t/f ) [ makes-24? ] with-datastack first ;
|
||||
: 24-able? ( quad -- t/f ) [ makes-24? ] with-datastack first ;
|
||||
: 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ;
|
||||
: set-commands ( -- ) { + - * / rot swap q } commands set ;
|
||||
: play-game ( -- ) set-commands 24-able repeat ;
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ HELP: reset-progress ( -- )
|
|||
"a loop which makes use of " { $link progress } "."
|
||||
} ;
|
||||
|
||||
HELP: progress ( -- time )
|
||||
HELP: progress
|
||||
{ $values { "time" "an integer" } }
|
||||
{ $description
|
||||
"Gives the time elapsed since the last time"
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ SYMBOL: sleep-period
|
|||
|
||||
: reset-progress ( -- ) millis last-loop set ;
|
||||
! : my-progress ( -- progress ) millis
|
||||
: progress ( -- progress ) millis last-loop get - reset-progress ;
|
||||
: progress ( -- time ) millis last-loop get - reset-progress ;
|
||||
: progress-peek ( -- progress ) millis last-loop get - ;
|
||||
: set-end ( duration -- end-time ) duration>milliseconds millis + ;
|
||||
: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ HELP: ctags-write ( seq path -- )
|
|||
{ $notes
|
||||
{ $snippet "tags" } " file will contain a single line: if\\t/path/to/factor/extra/unix/unix.factor\\t91" } ;
|
||||
|
||||
HELP: ctag-strings ( alist -- seq )
|
||||
HELP: ctag-strings
|
||||
{ $values { "alist" "an association list" }
|
||||
{ "seq" sequence } }
|
||||
{ $description "Converts an " { $snippet "alist" } " with ctag format (a word as key and a sequence whose first element is a resource name and a second element is a line number as value) in a " { $snippet "seq" } " of ctag strings." }
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ IN: ctags
|
|||
ctag-lineno number>string %
|
||||
] "" make ;
|
||||
|
||||
: ctag-strings ( seq1 -- seq2 )
|
||||
: ctag-strings ( alist -- seq )
|
||||
[ ctag ] map ;
|
||||
|
||||
: ctags-write ( seq path -- )
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
|
||||
USING: kernel fry sequences
|
||||
vocabs.loader tools.vocabs.browser
|
||||
vocabs.loader help.vocabs
|
||||
ui ui.gadgets ui.gadgets.buttons ui.gadgets.packs ui.gadgets.scrollers
|
||||
ui.tools.listener
|
||||
accessors ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
USING: accessors arrays assocs combinators help help.crossref
|
||||
help.markup help.topics io io.streams.string kernel make namespaces
|
||||
parser prettyprint sequences summary tools.vocabs tools.vocabs.browser
|
||||
parser prettyprint sequences summary tools.vocabs help.vocabs
|
||||
vocabs vocabs.loader words see ;
|
||||
|
||||
IN: fuel.help
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: slides help.markup math arrays hashtables namespaces
|
||||
sequences kernel sequences parser memoize io.encodings.binary
|
||||
locals kernel.private tools.vocabs.browser assocs quotations
|
||||
locals kernel.private help.vocabs assocs quotations
|
||||
urls peg.ebnf tools.vocabs tools.annotations tools.crossref
|
||||
help.topics math.functions compiler.tree.optimizer
|
||||
compiler.cfg.optimizer fry ;
|
||||
|
|
|
|||
|
|
@ -2,10 +2,10 @@ USING: windows.dinput windows.dinput.constants parser
|
|||
alien.c-types windows.ole32 namespaces assocs kernel arrays
|
||||
vectors windows.kernel32 windows.com windows.dinput shuffle
|
||||
windows.user32 windows.messages sequences combinators locals
|
||||
math.rectangles ui.windows accessors math windows alien
|
||||
math.rectangles accessors math windows alien
|
||||
alien.strings io.encodings.utf16 io.encodings.utf16n
|
||||
continuations byte-arrays game-input.dinput.keys-array
|
||||
game-input ;
|
||||
game-input ui.backend.windows ;
|
||||
IN: game-input.dinput
|
||||
|
||||
SINGLETON: dinput-game-input-backend
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ PRIVATE>
|
|||
] when ;
|
||||
|
||||
: with-game-input ( quot -- )
|
||||
open-game-input [ close-game-input ] [ ] cleanup ;
|
||||
open-game-input [ close-game-input ] [ ] cleanup ; inline
|
||||
|
||||
TUPLE: controller handle ;
|
||||
TUPLE: controller-state x y z rx ry rz slider pov buttons ;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: slides help.markup math arrays hashtables namespaces
|
||||
sequences kernel sequences parser memoize io.encodings.binary
|
||||
locals kernel.private tools.vocabs.browser assocs quotations
|
||||
locals kernel.private help.vocabs assocs quotations
|
||||
urls peg.ebnf tools.vocabs tools.annotations tools.crossref
|
||||
help.topics math.functions compiler.tree.optimizer
|
||||
compiler.cfg.optimizer fry ;
|
||||
|
|
|
|||
|
|
@ -46,7 +46,7 @@ TUPLE: link attributes clickable ;
|
|||
: find-between-all ( vector quot -- seq )
|
||||
dupd
|
||||
'[ _ [ closing?>> not ] bi and ] find-all
|
||||
[ first2 find-between* ] with map ;
|
||||
[ first2 find-between* ] with map ; inline
|
||||
|
||||
: remove-blank-text ( vector -- vector' )
|
||||
[
|
||||
|
|
@ -113,7 +113,7 @@ TUPLE: link attributes clickable ;
|
|||
[ clickable>> [ bl bl text>> print ] each nl ] bi ;
|
||||
|
||||
: find-by-text ( seq quot -- tag )
|
||||
[ dup name>> text = ] prepose find drop ;
|
||||
[ dup name>> text = ] prepose find drop ; inline
|
||||
|
||||
: find-opening-tags-by-name ( name seq -- seq )
|
||||
[ [ name>> = ] [ closing?>> not ] bi and ] with find-all ;
|
||||
|
|
|
|||
|
|
@ -137,7 +137,7 @@ SYMBOL: tagstack
|
|||
] when ;
|
||||
|
||||
: tag-parse ( quot -- vector )
|
||||
V{ } clone tagstack [ string-parse ] with-variable ;
|
||||
V{ } clone tagstack [ string-parse ] with-variable ; inline
|
||||
|
||||
: parse-html ( string -- vector )
|
||||
[ (parse-html) tagstack get ] tag-parse ;
|
||||
|
|
|
|||
|
|
@ -5,22 +5,22 @@ IN: html.parser.state
|
|||
|
||||
TUPLE: state string i ;
|
||||
|
||||
: get-i ( -- i ) state get i>> ;
|
||||
: get-i ( -- i ) state get i>> ; inline
|
||||
|
||||
: get-char ( -- char )
|
||||
state get [ i>> ] [ string>> ] bi ?nth ;
|
||||
state get [ i>> ] [ string>> ] bi ?nth ; inline
|
||||
|
||||
: get-next ( -- char )
|
||||
state get [ i>> 1+ ] [ string>> ] bi ?nth ;
|
||||
state get [ i>> 1+ ] [ string>> ] bi ?nth ; inline
|
||||
|
||||
: next ( -- )
|
||||
state get [ 1+ ] change-i drop ;
|
||||
state get [ 1+ ] change-i drop ; inline
|
||||
|
||||
: string-parse ( string quot -- )
|
||||
[ 0 state boa state ] dip with-variable ;
|
||||
[ 0 state boa state ] dip with-variable ; inline
|
||||
|
||||
: short* ( n seq -- n' seq )
|
||||
over [ nip dup length swap ] unless ;
|
||||
over [ nip dup length swap ] unless ; inline
|
||||
|
||||
: skip-until ( quot: ( -- ? ) -- )
|
||||
get-char [
|
||||
|
|
@ -30,12 +30,12 @@ TUPLE: state string i ;
|
|||
|
||||
: take-until ( quot: ( -- ? ) -- )
|
||||
get-i [ skip-until ] dip get-i
|
||||
state get string>> subseq ;
|
||||
state get string>> subseq ; inline
|
||||
|
||||
: string-matches? ( string circular -- ? )
|
||||
get-char over push-growing-circular sequence= ;
|
||||
get-char over push-growing-circular sequence= ; inline
|
||||
|
||||
: take-string ( match -- string )
|
||||
dup length <growing-circular>
|
||||
[ 2dup string-matches? ] take-until nip
|
||||
dup length rot length 1- - head next ;
|
||||
dup length rot length 1- - head next ; inline
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ CONSTANT: five 5
|
|||
USING: kernel literals prettyprint ;
|
||||
IN: scratchpad
|
||||
|
||||
<< : seven-eleven 7 11 ; >>
|
||||
<< : seven-eleven ( -- a b ) 7 11 ; >>
|
||||
{ $ seven-eleven } .
|
||||
"> "{ 7 11 }" }
|
||||
|
||||
|
|
@ -37,7 +37,7 @@ HELP: $[
|
|||
USING: kernel literals math prettyprint ;
|
||||
IN: scratchpad
|
||||
|
||||
<< : five 5 ; >>
|
||||
<< CONSTANT: five 5 >>
|
||||
{ $[ five dup 1+ dup 2 + ] } .
|
||||
"> "{ 5 6 8 }" }
|
||||
|
||||
|
|
@ -51,7 +51,7 @@ ARTICLE: "literals" "Interpolating code results into literal values"
|
|||
USING: kernel literals math prettyprint ;
|
||||
IN: scratchpad
|
||||
|
||||
<< : five 5 ; >>
|
||||
<< CONSTANT: five 5 >>
|
||||
{ $ five $[ five dup 1+ dup 2 + ] } .
|
||||
"> "{ 5 5 6 8 }" }
|
||||
{ $subsection POSTPONE: $ }
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@ io.files io.launcher mason.child mason.cleanup mason.common
|
|||
mason.help mason.release mason.report namespaces prettyprint ;
|
||||
IN: mason.build
|
||||
|
||||
QUALIFIED: continuations
|
||||
|
||||
: create-build-dir ( -- )
|
||||
now datestamp stamp set
|
||||
build-dir make-directory ;
|
||||
|
|
@ -21,10 +23,11 @@ IN: mason.build
|
|||
create-build-dir
|
||||
enter-build-dir
|
||||
clone-builds-factor
|
||||
record-id
|
||||
build-child
|
||||
upload-help
|
||||
release
|
||||
cleanup ;
|
||||
[
|
||||
record-id
|
||||
build-child
|
||||
upload-help
|
||||
release
|
||||
] [ cleanup ] [ ] continuations:cleanup ;
|
||||
|
||||
MAIN: build
|
||||
MAIN: build
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! Copyright (C) 2008, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel math sequences vectors classes classes.algebra
|
||||
combinators arrays words assocs parser namespaces make
|
||||
definitions prettyprint prettyprint.backend prettyprint.custom
|
||||
quotations generalizations debugger io compiler.units
|
||||
kernel.private effects accessors hashtables sorting shuffle
|
||||
math.order sets see ;
|
||||
math.order sets see effects.parser ;
|
||||
IN: multi-methods
|
||||
|
||||
! PART I: Converting hook specializers
|
||||
|
|
@ -214,17 +214,16 @@ M: no-method error.
|
|||
[ "multi-method-specializer" word-prop ]
|
||||
[ "multi-method-generic" word-prop ] bi prefix ;
|
||||
|
||||
: define-generic ( word -- )
|
||||
dup "multi-methods" word-prop [
|
||||
drop
|
||||
] [
|
||||
: define-generic ( word effect -- )
|
||||
over set-stack-effect
|
||||
dup "multi-methods" word-prop [ drop ] [
|
||||
[ H{ } clone "multi-methods" set-word-prop ]
|
||||
[ update-generic ]
|
||||
bi
|
||||
] if ;
|
||||
|
||||
! Syntax
|
||||
SYNTAX: GENERIC: CREATE define-generic ;
|
||||
SYNTAX: GENERIC: CREATE-WORD complete-effect define-generic ;
|
||||
|
||||
: parse-method ( -- quot classes generic )
|
||||
parse-definition [ 2 tail ] [ second ] [ first ] tri ;
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ DEFER: fake
|
|||
|
||||
DEFER: testing
|
||||
|
||||
[ ] [ \ testing define-generic ] unit-test
|
||||
[ ] [ \ testing (( -- )) define-generic ] unit-test
|
||||
|
||||
[ t ] [ \ testing generic? ] unit-test
|
||||
] with-compilation-unit
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ USING: multi-methods tools.test math sequences namespaces system
|
|||
kernel strings definitions prettyprint debugger arrays
|
||||
hashtables continuations classes assocs accessors see ;
|
||||
|
||||
GENERIC: first-test
|
||||
GENERIC: first-test ( -- )
|
||||
|
||||
[ t ] [ \ first-test generic? ] unit-test
|
||||
|
||||
|
|
@ -13,7 +13,7 @@ SINGLETON: paper INSTANCE: paper thing
|
|||
SINGLETON: scissors INSTANCE: scissors thing
|
||||
SINGLETON: rock INSTANCE: rock thing
|
||||
|
||||
GENERIC: beats?
|
||||
GENERIC: beats? ( obj1 obj2 -- ? )
|
||||
|
||||
METHOD: beats? { paper scissors } t ;
|
||||
METHOD: beats? { scissors rock } t ;
|
||||
|
|
@ -34,7 +34,7 @@ METHOD: beats? { thing thing } f ;
|
|||
|
||||
SYMBOL: some-var
|
||||
|
||||
GENERIC: hook-test
|
||||
GENERIC: hook-test ( -- obj )
|
||||
|
||||
METHOD: hook-test { array { some-var array } } reverse ;
|
||||
METHOD: hook-test { { some-var array } } class ;
|
||||
|
|
@ -57,7 +57,7 @@ TUPLE: busted-1 ;
|
|||
TUPLE: busted-2 ; INSTANCE: busted-2 busted
|
||||
TUPLE: busted-3 ;
|
||||
|
||||
GENERIC: busted-sort
|
||||
GENERIC: busted-sort ( obj1 obj2 -- obj1 obj2 )
|
||||
|
||||
METHOD: busted-sort { busted-1 busted-2 } ;
|
||||
METHOD: busted-sort { busted-2 busted-3 } ;
|
||||
|
|
|
|||
|
|
@ -140,11 +140,11 @@ METHOD: as-mutate { object object assoc } set-at ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: filter-of ( quot seq -- seq ) swap filter ;
|
||||
: filter-of ( quot seq -- seq ) swap filter ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: map-over ( quot seq -- seq ) swap map ;
|
||||
: map-over ( quot seq -- seq ) swap map ; inline
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -242,7 +242,7 @@ METHOD: as-mutate { object object assoc } set-at ;
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: purge ( seq quot -- seq ) [ not ] compose filter ;
|
||||
: purge ( seq quot -- seq ) [ not ] compose filter ; inline
|
||||
|
||||
: purge! ( seq quot -- seq )
|
||||
dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ;
|
||||
dupd '[ swap @ [ pluck! ] [ drop ] if ] each-index ; inline
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: slides help.markup math arrays hashtables namespaces sequences
|
||||
kernel sequences parser memoize io.encodings.binary locals
|
||||
kernel.private tools.vocabs.browser assocs quotations tools.vocabs
|
||||
kernel.private help.vocabs assocs quotations tools.vocabs
|
||||
tools.annotations tools.crossref help.topics math.functions
|
||||
compiler.tree.optimizer compiler.cfg.optimizer fry ui.gadgets.panes
|
||||
tetris tetris.game combinators generalizations multiline
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Doug Coleman
|
||||
|
|
@ -0,0 +1,334 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: calendar io.encodings.utf8 io.files robots tools.test ;
|
||||
IN: robots.tests
|
||||
|
||||
[
|
||||
{ "http://www.chiplist.com/sitemap.txt" }
|
||||
{
|
||||
T{ rules
|
||||
{ user-agents V{ "*" } }
|
||||
{ allows V{ } }
|
||||
{ disallows
|
||||
V{
|
||||
"/cgi-bin/"
|
||||
"/scripts/"
|
||||
"/ChipList2/scripts/"
|
||||
"/ChipList2/styles/"
|
||||
"/ads/"
|
||||
"/ChipList2/ads/"
|
||||
"/advertisements/"
|
||||
"/ChipList2/advertisements/"
|
||||
"/graphics/"
|
||||
"/ChipList2/graphics/"
|
||||
}
|
||||
}
|
||||
{ visit-time
|
||||
{
|
||||
T{ timestamp { hour 2 } }
|
||||
T{ timestamp { hour 5 } }
|
||||
}
|
||||
}
|
||||
{ request-rate 1 }
|
||||
{ crawl-delay 1 }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "UbiCrawler" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "DOC" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Zao" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "sitecheck.internetseer.com" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Zealbot" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "MSIECrawler" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "SiteSnagger" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "WebStripper" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "WebCopier" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Fetch" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Offline Explorer" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Teleport" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "TeleportPro" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "WebZIP" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "linko" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "HTTrack" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Microsoft.URL.Control" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Xenu" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "larbin" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "libwww" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "ZyBORG" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "Download Ninja" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "wget" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "grub-client" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "k2spider" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "NPBot" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents V{ "WebReaper" } }
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
T{ rules
|
||||
{ user-agents
|
||||
V{
|
||||
"abot"
|
||||
"ALeadSoftbot"
|
||||
"BeijingCrawler"
|
||||
"BilgiBot"
|
||||
"bot"
|
||||
"botlist"
|
||||
"BOTW Spider"
|
||||
"bumblebee"
|
||||
"Bumblebee"
|
||||
"BuzzRankingBot"
|
||||
"Charlotte"
|
||||
"Clushbot"
|
||||
"Crawler"
|
||||
"CydralSpider"
|
||||
"DataFountains"
|
||||
"DiamondBot"
|
||||
"Dulance bot"
|
||||
"DYNAMIC"
|
||||
"EARTHCOM.info"
|
||||
"EDI"
|
||||
"envolk"
|
||||
"Exabot"
|
||||
"Exabot-Images"
|
||||
"Exabot-Test"
|
||||
"exactseek-pagereaper"
|
||||
"Exalead NG"
|
||||
"FANGCrawl"
|
||||
"Feed::Find"
|
||||
"flatlandbot"
|
||||
"Gigabot"
|
||||
"GigabotSiteSearch"
|
||||
"GurujiBot"
|
||||
"Hatena Antenna"
|
||||
"Hatena Bookmark"
|
||||
"Hatena RSS"
|
||||
"HatenaScreenshot"
|
||||
"Helix"
|
||||
"HiddenMarket"
|
||||
"HyperEstraier"
|
||||
"iaskspider"
|
||||
"IIITBOT"
|
||||
"InfociousBot"
|
||||
"iVia"
|
||||
"iVia Page Fetcher"
|
||||
"Jetbot"
|
||||
"Kolinka Forum Search"
|
||||
"KRetrieve"
|
||||
"LetsCrawl.com"
|
||||
"Lincoln State Web Browser"
|
||||
"Links4US-Crawler"
|
||||
"LOOQ"
|
||||
"Lsearch/sondeur"
|
||||
"MapoftheInternet.com"
|
||||
"NationalDirectory"
|
||||
"NetCarta_WebMapper"
|
||||
"NewsGator"
|
||||
"NextGenSearchBot"
|
||||
"ng"
|
||||
"nicebot"
|
||||
"NP"
|
||||
"NPBot"
|
||||
"Nudelsalat"
|
||||
"Nutch"
|
||||
"OmniExplorer_Bot"
|
||||
"OpenIntelligenceData"
|
||||
"Oracle Enterprise Search"
|
||||
"Pajaczek"
|
||||
"panscient.com"
|
||||
"PeerFactor 404 crawler"
|
||||
"PeerFactor Crawler"
|
||||
"PlantyNet"
|
||||
"PlantyNet_WebRobot"
|
||||
"plinki"
|
||||
"PMAFind"
|
||||
"Pogodak!"
|
||||
"QuickFinder Crawler"
|
||||
"Radiation Retriever"
|
||||
"Reaper"
|
||||
"RedCarpet"
|
||||
"ScorpionBot"
|
||||
"Scrubby"
|
||||
"Scumbot"
|
||||
"searchbot"
|
||||
"Seeker.lookseek.com"
|
||||
"SeznamBot"
|
||||
"ShowXML"
|
||||
"snap.com"
|
||||
"snap.com beta crawler"
|
||||
"Snapbot"
|
||||
"SnapPreviewBot"
|
||||
"sohu"
|
||||
"SpankBot"
|
||||
"Speedy Spider"
|
||||
"Speedy_Spider"
|
||||
"SpeedySpider"
|
||||
"spider"
|
||||
"SquigglebotBot"
|
||||
"SurveyBot"
|
||||
"SynapticSearch"
|
||||
"T-H-U-N-D-E-R-S-T-O-N-E"
|
||||
"Talkro Web-Shot"
|
||||
"Tarantula"
|
||||
"TerrawizBot"
|
||||
"TheInformant"
|
||||
"TMCrawler"
|
||||
"TridentSpider"
|
||||
"Tutorial Crawler"
|
||||
"Twiceler"
|
||||
"unwrapbot"
|
||||
"URI::Fetch"
|
||||
"VengaBot"
|
||||
"Vonna.com b o t"
|
||||
"Vortex"
|
||||
"Votay bot"
|
||||
"WebAlta Crawler"
|
||||
"Webbot"
|
||||
"Webclipping.com"
|
||||
"WebCorp"
|
||||
"Webinator"
|
||||
"WIRE"
|
||||
"WISEbot"
|
||||
"Xerka WebBot"
|
||||
"XSpider"
|
||||
"YodaoBot"
|
||||
"Yoono"
|
||||
"yoono"
|
||||
}
|
||||
}
|
||||
{ allows V{ } }
|
||||
{ disallows V{ "/" } }
|
||||
{ unknowns H{ } }
|
||||
}
|
||||
}
|
||||
] [ "vocab:robots/robots.txt" utf8 file-contents parse-robots.txt ] unit-test
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors http.client kernel unicode.categories
|
||||
sequences urls splitting combinators splitting.monotonic
|
||||
combinators.short-circuit assocs unicode.case arrays
|
||||
math.parser calendar.format make ;
|
||||
IN: robots
|
||||
|
||||
! visit-time is GMT, request-rate is pages/second
|
||||
! crawl-rate is seconds
|
||||
TUPLE: rules user-agents allows disallows
|
||||
visit-time request-rate crawl-delay unknowns ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: >robots.txt-url ( url -- url' )
|
||||
>url URL" robots.txt" derive-url ;
|
||||
|
||||
: get-robots.txt ( url -- headers robots.txt )
|
||||
>robots.txt-url http-get ;
|
||||
|
||||
: normalize-robots.txt ( string -- sitemaps seq )
|
||||
string-lines
|
||||
[ [ blank? ] trim ] map
|
||||
[ "#" head? not ] filter harvest
|
||||
[ ":" split1 [ [ blank? ] trim ] bi@ [ >lower ] dip ] { } map>assoc
|
||||
[ first "sitemap" = ] partition [ values ] dip
|
||||
[
|
||||
{
|
||||
[ [ first "user-agent" = ] bi@ and ]
|
||||
[ nip first "user-agent" = not ]
|
||||
} 2||
|
||||
] monotonic-split ;
|
||||
|
||||
: <rules> ( -- rules )
|
||||
rules new
|
||||
V{ } clone >>user-agents
|
||||
V{ } clone >>allows
|
||||
V{ } clone >>disallows
|
||||
H{ } clone >>unknowns ;
|
||||
|
||||
: add-user-agent ( rules agent -- rules ) over user-agents>> push ;
|
||||
: add-allow ( rules allow -- rules ) over allows>> push ;
|
||||
: add-disallow ( rules disallow -- rules ) over disallows>> push ;
|
||||
|
||||
: parse-robots.txt-line ( rules seq -- rules )
|
||||
first2 swap {
|
||||
{ "user-agent" [ add-user-agent ] }
|
||||
{ "allow" [ add-allow ] }
|
||||
{ "disallow" [ add-disallow ] }
|
||||
{ "crawl-delay" [ string>number >>crawl-delay ] }
|
||||
{ "request-rate" [ string>number >>request-rate ] }
|
||||
{
|
||||
"visit-time" [ "-" split1 [ hhmm>timestamp ] bi@ 2array
|
||||
>>visit-time
|
||||
] }
|
||||
[ pick unknowns>> push-at ]
|
||||
} case ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: parse-robots.txt ( string -- sitemaps rules-seq )
|
||||
normalize-robots.txt [
|
||||
[ <rules> dup ] dip [ parse-robots.txt-line drop ] with each
|
||||
] map ;
|
||||
|
||||
: robots ( url -- sitemaps rules-seq )
|
||||
get-robots.txt nip parse-robots.txt ;
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue