Merge branch 'master' of git://factorcode.org/git/factor

basis/bootstrap/help/help.factor

@@ -5,7 +5,7 @@ IN: bootstrap.help
 
 : load-help ( -- )
     "help.lint" require
-    "tools.vocabs.browser" require
+    "help.vocabs" require
     "alien.syntax" require
     "compiler" require
 

basis/bootstrap/tools/tools.factor

@@ -14,7 +14,6 @@ IN: bootstrap.tools
     "tools.time"
     "tools.threads"
     "tools.vocabs"
-    "tools.vocabs.browser"
     "tools.vocabs.monitor"
     "editors"
 } [ require ] each

basis/calendar/format/format.factor

@@ -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 -- )

basis/cocoa/messages/messages.factor

@@ -22,15 +22,13 @@ SYMBOL: super-message-senders
 message-senders [ H{ } clone ] initialize
 super-message-senders [ H{ } clone ] initialize
 
-: cache-stub ( method function hash -- )
+: cache-stub ( method assoc function -- )
-    [
+    '[ _ sender-stub ] cache drop ;
-        over get [ 2drop ] [ over [ sender-stub ] dip set ] if
-    ] bind ;
 
 : cache-stubs ( method -- )
-    dup
+    [ super-message-senders get "objc_msgSendSuper" cache-stub ]
-    "objc_msgSendSuper" super-message-senders get cache-stub
+    [ message-senders get "objc_msgSend" cache-stub ]
-    "objc_msgSend" message-senders get cache-stub ;
+    bi ;
 
 : <super> ( receiver -- super )
     "objc-super" <c-object> [

basis/cocoa/views/views.factor

@@ -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 ;

basis/grouping/grouping-docs.factor

@@ -97,8 +97,7 @@ HELP: <clumps>
     { $example
         "USING: grouping sequences math prettyprint kernel ;"
         "IN: scratchpad"
-        ": share-price"
+        "CONSTANT: share-price { 13/50 51/100 13/50 1/10 4/5 17/20 33/50 3/25 19/100 3/100 }"
-        "    { 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 }"

basis/help/apropos/apropos-docs.factor

@@ -1,6 +1,8 @@
-IN: tools.apropos
+IN: help.apropos
-USING: help.markup help.syntax strings ;
+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." ;

basis/help/apropos/apropos-tests.factor

@@ -0,0 +1,4 @@
+IN: help.apropos.tests
+USING: help.apropos tools.test ;
+
+[ ] [ "swp" apropos ] unit-test

basis/help/apropos/apropos.factor

@@ -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 ;

basis/help/cookbook/cookbook.factor

@@ -121,16 +121,16 @@ $nl
     "sequences"
 } ;
 
-ARTICLE: "cookbook-variables" "Variables cookbook"
+ARTICLE: "cookbook-variables" "Dynamic variables cookbook"
-"Before using a variable, you must define a symbol for it:"
-{ $code "SYMBOL: name" }
 "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
+{ $unchecked-example
-    ": print-name name get print ;"
+    ": 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"
 } ;
 

basis/help/handbook/handbook.factor

@@ -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"
+ARTICLE: "handbook" "Factor handbook"
-"Welcome to Factor."
-$nl
-"Explore the code base:"
-{ $subsection "vocab-index" }
 "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"

basis/help/help-docs.factor

@@ -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

basis/help/home/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/help/home/home-docs.factor

@@ -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"

basis/help/home/home.factor

@@ -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 ;

basis/help/html/html.factor

@@ -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

basis/help/tips/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/help/tips/tips-docs.factor

@@ -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"

basis/help/tips/tips.factor

@@ -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 ;

basis/help/tutorial/tutorial.factor

@@ -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" } ;
 

basis/help/vocabs/vocabs-docs.factor

@@ -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 } ;

basis/help/vocabs/vocabs-tests.factor

@@ -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

basis/help/vocabs/vocabs.factor

@@ -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
+tools.vocabs vocabs vocabs.loader words words.symbol definitions.icons ;
-combinators.smart definitions.icons ;
+IN: help.vocabs
-IN: tools.vocabs.browser
+
+: $pretty-link ( element -- )
+    [ first definition-icon 1array $image " " print-element ]
+    [ $definition-link ]
+    bi ;
 
 : <$pretty-link> ( definition -- element )
-    [
+    1array \ $pretty-link prefix ;
-        [ definition-icon 1array \ $image prefix ]
-        [ drop " " ]
-        [ 1array \ $definition-link prefix ]
-        tri
-    ] output>array ;
 
 : vocab-row ( vocab -- row )
     [ <$pretty-link> ] [ vocab-summary ] bi 2array ;

basis/lists/lazy/lazy-docs.factor

@@ -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

basis/lists/lazy/lazy.factor

@@ -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 ;

basis/locals/locals-tests.factor

@@ -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 ) ;

basis/locals/macros/macros.factor

@@ -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 '[ @ ] ;

basis/macros/expander/expander.factor

@@ -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 -- )
 

basis/math/bitwise/bitwise-docs.factor

@@ -139,8 +139,8 @@ HELP: flags
 { $examples
     { $example "USING: math.bitwise kernel prettyprint ;"
         "IN: scratchpad"
-        ": MY-CONSTANT HEX: 1 ; inline"
+        "CONSTANT: x HEX: 1"
-        "{ HEX: 20 MY-CONSTANT BIN: 100 } flags .h"
+        "{ HEX: 20 x BIN: 100 } flags .h"
         "25"
     }
 } ;

basis/memoize/memoize-docs.factor

@@ -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: } ;

basis/peg/parsers/parsers.factor

@@ -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 ;

basis/peg/peg.factor

@@ -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
+  pos get apply-rule process-parser-result ;
-
-: 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 ;
 
 : 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 ,
+      parsers>> unclip compile-parser-quot [ parse-seq-element ] curry ,
-      [ compile-parser 1quotation [ merge-errors ] compose [ parse-seq-element ] curry , ] each 
+      [ 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 
+      parsers>> [ compile-parser-quot ] map 
-      unclip 1quotation , [ 1quotation [ merge-errors ] compose , ] each
+      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>
 

basis/refs/refs-docs.factor

@@ -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

basis/refs/refs.factor

@@ -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 ;

basis/see/see-docs.factor

@@ -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"

basis/see/see.factor

@@ -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 ;

basis/stack-checker/stack-checker-docs.factor

@@ -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."

basis/stack-checker/stack-checker-tests.factor

@@ -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
 

basis/tools/apropos/apropos-tests.factor

@@ -1,4 +0,0 @@
-IN: tools.apropos.tests
-USING: tools.apropos tools.test ;
-
-[ ] [ "swp" apropos ] unit-test

basis/tools/deploy/shaker/shaker.factor

@@ -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

basis/tools/vocabs/browser/browser-tests.factor

@@ -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

basis/ui/backend/windows/windows.factor

@@ -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

basis/ui/commands/commands-docs.factor

@@ -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"
     }

basis/ui/gadgets/editors/editors-docs.factor

@@ -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"

basis/ui/tools/browser/browser.factor

@@ -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
+USING: debugger help help.topics help.crossref help.home kernel
-assocs words vocabs accessors fry combinators.short-circuit
+models compiler.units assocs words vocabs accessors fry
-sequences models models.history tools.apropos combinators
+combinators.short-circuit namespaces sequences models
-ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
+models.history help.apropos combinators ui.commands ui.gadgets
-ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
+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 ] [ model>> ] bi*
-    [ >link ] dip set-model ;
+    [ [ 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 ;
 

basis/ui/tools/deploy/deploy-docs.factor

@@ -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"

basis/ui/tools/listener/completion/completion.factor

@@ -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

basis/ui/tools/listener/listener-docs.factor

@@ -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"

basis/ui/tools/listener/listener.factor

@@ -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
+help.tips concurrency.flags concurrency.mailboxes continuations
-documents documents.elements fry hashtables help help.markup io
+destructors documents documents.elements fry hashtables help
-io.styles kernel lexer listener math models models.delay models.arrow
+help.markup io io.styles kernel lexer listener math models
-namespaces parser prettyprint quotations sequences strings threads
+models.delay models.arrow namespaces parser prettyprint quotations
-tools.vocabs vocabs vocabs.loader vocabs.parser words debugger ui ui.commands
+sequences strings threads tools.vocabs vocabs vocabs.loader
-ui.pens.solid ui.gadgets ui.gadgets.glass ui.gadgets.buttons ui.gadgets.editors
+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
 

basis/ui/tools/operations/operations-docs.factor

@@ -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" } ")." ;

basis/ui/tools/operations/operations.factor

@@ -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 }

basis/ui/tools/profiler/profiler-docs.factor

@@ -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"

basis/ui/tools/profiler/profiler.factor

@@ -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

basis/ui/tools/tools-docs.factor

@@ -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"

basis/windows/dinput/constants/constants.factor

@@ -832,7 +832,7 @@ SYMBOLS:
     define-keyboard-format-constant
     define-hid-keyboard-format-constant ;
 
-: define-constants
+: define-constants ( -- )
     define-guid-constants
     define-format-constants ;
 

basis/windows/dinput/dinput.factor

@@ -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
 

build-support/factor.sh

@@ -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() {

core/definitions/definitions-docs.factor

@@ -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:"

core/generic/generic-docs.factor

@@ -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" } ;

core/math/math-docs.factor

@@ -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"

core/memory/memory-tests.factor

@@ -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
 

core/parser/parser.factor

@@ -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"

core/strings/strings-docs.factor

@@ -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" } "." } ;
 

core/strings/strings.factor

@@ -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
 

core/syntax/syntax-docs.factor

@@ -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" }

core/words/words-docs.factor

@@ -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 -- ? )
+HELP: parsing-word?
-{ $values { "obj" object } { "?" "a boolean" } }
+{ $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." } ;
 

extra/24-game/24-game.factor

@@ -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 ;

extra/animations/animations-docs.factor

@@ -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"

extra/animations/animations.factor

@@ -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

extra/ctags/ctags-docs.factor

@@ -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." }

extra/ctags/ctags.factor

@@ -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 -- )

extra/demos/demos.factor

@@ -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 ;

extra/ecdsa/tags.txt

@@ -0,0 +1 @@
+unportable

extra/fuel/help/help.factor

@@ -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

extra/galois-talk/galois-talk.factor

@@ -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 ;

extra/game-input/dinput/dinput.factor

@@ -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

extra/game-input/game-input.factor

@@ -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 ;

extra/google-tech-talk/google-tech-talk.factor

@@ -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 ;

extra/html/parser/analyzer/analyzer.factor

@@ -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 ;

extra/html/parser/parser.factor

@@ -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 ;

extra/html/parser/state/state.factor

@@ -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

extra/literals/literals-docs.factor

@@ -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: $ }

extra/mason/build/build.factor

@@ -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 ;
+    ] [ cleanup ] [ ] continuations:cleanup ;
 
 MAIN: build

extra/multi-methods/multi-methods.factor

@@ -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 -- )
+: define-generic ( word effect -- )
-    dup "multi-methods" word-prop [
+    over set-stack-effect
-        drop
+    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 ;

extra/multi-methods/tests/definitions.factor

@@ -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

extra/multi-methods/tests/syntax.factor

@@ -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 } ;

extra/newfx/newfx.factor

@@ -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

extra/otug-talk/otug-talk.factor

@@ -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

extra/robots/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

extra/robots/robots-tests.factor

@@ -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

extra/robots/robots.factor

@@ -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 ;