Started help cross-referencing, updating documentation

TODO.FACTOR.txt

@@ -50,6 +50,7 @@
 - grid layout
 - variable width word wrap
 - fix top level window positioning
+- changing window titles
 
 + compiler/ffi:
 

doc/handbook/handbook.facts

@@ -36,4 +36,11 @@ ARTICLE: "quickref" "Quick reference"
     "An unhandled error was caught:\n\nParsing <interactive>:1\nfdafasfa\n        ^\n\"Not a number\"\n\n:s :r show stacks at time of error.\n:get ( var -- value ) inspects the error namestack."
 }
 "Sometimes, the word " { $emphasis "does" } " exist, but you might need to " { $link POSTPONE: USE: } " its vocabulary first. The " { $link apropos } " word can help locate the correct vocabulary:"
-{ $example "\"<label>\" apropos" "IN: gadgets-labels : <label>\nIN: compiler-backend : <label>" } ;
+{ $example "\"<label>\" apropos" "IN: gadgets-labels : <label>\nIN: compiler-backend : <label>" }
+$terpri
+"A simple program:"
+{ $code
+    "USING: kernel math ;"
+    ": factorial ( n -- n! )"
+    "    dup zero? [ drop 1 ] [ dup 1- factorial * ] if ;"
+} ;

library/alien/alien-callback.facts

@@ -0,0 +1,22 @@
+IN: alien
+USING: errors help ;
+
+HELP: alien-callback "( return parameters quot -- alien )"
+{ $values { "return" "a C return type" } { "parameters" "a sequence of C parameter types" } { "quot" "a quotation" } { "alien" "an alien address" } }
+{ $description
+    "Defines a callback from C to Factor which accepts the given set of parameters from the C caller, pushes them on the data stack, calls the quotation, and passes a return value back to the C caller."
+    $terpri
+    "This word only runs when it is called from within a " { $emphasis "compiled" } " word, with all three parameters as literal inputs. See " { $link "compiler" } "."
+    $terpri
+    "When a compiled reference to this word is called, it pushes the callback's alien address on the data stack. This address can be passed to any C function expecting a C function pointer with the correct signature. The callback is actually generated when the word calling " { $link alien-callback } " is compiled."
+    $terpri
+    "Callback quotations run with freshly-allocated stacks. This means the data stack contains the values passed by the C function, and nothing else. It also means that if the callback throws an error which is not caught, the Factor runtime will halt. See " { $link "errors" } " for error handling options."
+}
+{ $examples
+    "A simple example, showing a C function which returns the difference of two given integers:"
+    { $code
+        ": difference-callback ( -- alien )"
+        "    \"int\" { \"int\" \"int\" } [ - ] alien-callback ;"
+    }
+}
+{ $see-also alien-invoke } ;

library/alien/alien-invoke.factor

@@ -23,10 +23,6 @@ M: alien-invoke-error summary ( error -- )
     drop "Words calling ``alien-invoke'' cannot run in the interpreter. Compile the caller word and try again." ;
 
 : alien-invoke ( ... return library function parameters -- ... )
-    #! Call a C library function.
-    #! 'return' is a type spec, and 'parameters' is a list of
-    #! type specs. 'library' is an entry in the "libraries"
-    #! namespace.
     pick pick <alien-invoke-error> throw ;
 
 \ alien-invoke [ [ string object string object ] [ ] ]
@@ -88,7 +84,7 @@ M: alien-invoke stack-reserve*
     [ alien-invoke ] cons cons cons cons r> swap define-compound
     word r> "stack-effect" set-word-prop ;
 
-: define-c-word ( type lib func function-args -- )
+: define-c-word ( return library function parameters -- )
     [ "()" subseq? not ] subset >r pick r> parse-arglist
     (define-c-word) ;
 

library/alien/alien-invoke.facts

@@ -0,0 +1,14 @@
+IN: alien
+USING: help ;
+
+HELP: alien-invoke "( ... return library function parameters -- ... )"
+{ $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }
+{ $description "Calls a C library function with the given name. Input parameters are taken from the data stack, and the return value is pushed on the data stack after the function returns."
+$terpri
+"This word only runs when it is called from within a " { $emphasis "compiled" } " word, with all four parameters as literal inputs. See " { $link "compiler" } "." }
+{ $see-also alien-callback } ;
+
+HELP: define-c-word "( return library function parameters -- )"
+{ $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }
+{ $description "Defines a word named " { $snippet "function" } " in the current vocabulary (see " { $link "vocabularies" } "). The word calls " { $link alien-invoke } " with the specified parameters." }
+{ $notes "This word is used to implement the " { $link POSTPONE: FUNCTION: } " parsing word." } ;

library/alien/aliens.factor

@@ -4,19 +4,6 @@ IN: alien
 USING: arrays hashtables io kernel lists math namespaces parser
 sequences ;
 
-! USAGE:
-! 
-! Command line parameters given to the runtime specify libraries
-! to load.
-!
-! -libraries:<foo>:name=<soname> -- define a library <foo>, to be
-! loaded from the <soname> DLL.
-!
-! -libraries:<foo>:abi=stdcall -- define a library using the
-! stdcall ABI. This ABI is usually used on Win32. Any other abi
-! parameter, or a missing abi parameter indicates the cdecl ABI
-! should be used, which is common on Unix.
-
 : <alien> ( address -- alien )
     dup zero? [ drop f ] [ f <displaced-alien> ] if ; inline
 
@@ -38,7 +25,6 @@ global [ "libraries" nest drop ] bind
 : library ( name -- object ) "libraries" get hash ;
 
 : load-library ( name -- dll )
-    #! Higher level wrapper around dlopen primitive.
     library dup [
         [
             "dll" get dup [

library/alien/aliens.facts

@@ -0,0 +1,39 @@
+IN: alien
+USING: help ;
+
+HELP: <displaced-alien> "( displacement c-ptr -- alien )"
+{ $values { "displacement" "an integer" } { "c-ptr" "an alien, byte array, or " { $link f } } { "alien" "a new alien" } }
+{ $description "Creates a new alien address object, wrapping a raw memory address. The alien points to a location in memory which is offset by " { $snippet "displacement" } " from the address of " { $link "c-ptr" } ". Passing a value of " { $link f } " for " { $snippet "c-ptr" } " creates an alien with an absolute address." }
+{ $see-also <alien> alien-address } ;
+
+HELP: alien-address "( c-ptr -- addr )"
+{ $values { "c-ptr" "an alien, byte array, or " { $link f } } { "addr" "a non-negative integer" } }
+{ $description "Outputs the address of an alien." }
+{ $warning "Taking the address of a byte array is not safe. The byte array can be moved by the garbage collector between the time the address is taken, and when it is accessed. If you need to pass pointers to C functions which will persist across alien calls, you must allocate unmanaged memory instead. See " { $link "malloc" } "." } ;
+
+HELP: <alien> "( address -- alien )"
+{ $values { "address" "a non-negative integer" } { "alien" "a new alien address" } }
+{ $description "Creates an alien object, wrapping a raw memory address." }
+{ $see-also <displaced-alien> alien-address } ;
+
+HELP: c-ptr f
+{ $description "Class of objects consisting of aliens, byte arrays and " { $link f } ". These objects can convert to pointer C types, which are all aliases of " { $snippet "void*" } "." } ;
+
+HELP: library "( name -- library )"
+{ $values { "name" "a string" } { "library" "a hashtable" } }
+{ $description "Looks up a library by its logical name. The library object is a hashtable with the following keys:"
+    { $list
+        { { $snippet "name" } " - the full path of the C library binary" }
+        { { $snippet "abi" } " - the ABI used by the library, either " { $snippet "cdecl" } " or " { $snippet "stdcall" } }
+        { { $snippet "dll" } " - an instance of the " { $link dll } " class; only set if the library is loaded" }
+    }
+} ;
+
+HELP: load-library "( name -- dll )"
+{ $values { "name" "a string" } { "dll" "a DLL handle" } }
+{ $description "Loads a library by logical name. If the library is already loaded, returns the existing handle." }
+{ $errors "Throws an error if the library could not be found, or if loading fails for some other reason." } ;
+
+HELP: add-library "( name path abi -- )"
+{ $values { "name" "a string" } { "path" "a string" } { "abi" "one of " { $snippet "\"cdecl\"" } " or " { $snippet "\"stdcall\"" } } }
+{ $description "Defines a new logical library named " { $snippet "name" } " located in the file system at " { $snippet "path" } "and the specified ABI." } ;

library/alien/c-types.factor

@@ -47,28 +47,26 @@ SYMBOL: c-types
     "\0" append dup length malloc check-ptr
     [ alien-address string>memory ] keep ;
 
-: define-pointer ( type -- )
+: (typedef) ( old new -- ) c-types get [ >r get r> set ] bind ;
-    "void*" c-type swap "*" append c-types get set-hash ;
+
+: define-pointer ( type -- ) "*" append "void*" swap (typedef) ;
 
 : define-deref ( name vocab -- )
     >r dup "*" swap append r> create
     swap c-getter 0 swons define-compound ;
 
 : (define-nth) ( word type quot -- )
-    >r c-size [ rot * ] cons r> append define-compound ;
+    >r c-size [ rot * ] curry r> append define-compound ;
 
 : define-nth ( name vocab -- )
-    #! Make a word foo-nth ( n alien -- alien ).
     >r dup "-nth" append r> create
     swap dup c-getter (define-nth) ;
 
 : define-set-nth ( name vocab -- )
-    #! Make a word set-foo-nth ( value n alien -- ).
     >r "set-" over "-nth" append3 r> create
     swap dup c-setter (define-nth) ;
 
 : define-out ( name vocab -- )
-    #! Out parameter constructor for integral types.
     over [ <c-object> tuck 0 ] over c-setter append
     >r >r constructor-word r> r> cons define-compound ;
 
@@ -82,7 +80,5 @@ SYMBOL: c-types
     2dup define-set-nth
     define-out ;
 
-: (typedef) c-types get [ >r get r> set ] bind ;
-
 : typedef ( old new -- )
     over "*" append over "*" append (typedef) (typedef) ;

library/alien/c-types.facts

@@ -0,0 +1,112 @@
+IN: alien
+USING: help libc ;
+
+HELP: c-type "( name -- type )"
+{ $values { "name" "a string" } { "type" "a hashtable" } }
+{ $description "Looks up a C type by name." }
+{ $errors "Throws an error if the type does not exist." } ;
+
+HELP: c-size "( name -- size )"
+{ $values { "name" "a string" } { "size" "an integer" } }
+{ $description "Outputs the number of bytes taken up by this C type." }
+{ $examples
+    "On a 32-bit system, you will get the following output:"
+    { $example "USE: alien\n\"void*\" c-size ." "4" }
+}
+{ $errors "Throws an error if the type does not exist." } ;
+
+HELP: c-align "( name -- n )"
+{ $values { "name" "a string" } { "n" "an integer" } }
+{ $description "Outputs alignment at which values of this C type are padded in C structures." }
+{ $errors "Throws an error if the type does not exist." } ;
+
+HELP: c-getter "( name -- quot )"
+{ $values { "name" "a string" } { "quot" "a quotation with stack effect " { $snippet "( c-ptr n -- obj )" } } }
+{ $description "Outputs a quotation which reads values of this C type from a C structure." }
+{ $errors "Throws an error if the type does not exist." } ;
+
+HELP: c-setter "( name -- quot )"
+{ $values { "name" "a string" } { "quot" "a quotation with stack effect " { $snippet "( obj c-ptr n -- )" } } }
+{ $description "Outputs a quotation which writes values of this C type to a C structure." }
+{ $errors "Throws an error if the type does not exist." } ;
+
+HELP: <c-array> "( n type -- array )"
+{ $values { "n" "a non-negative integer" } { "type" "a string" } { "array" "a byte array" } }
+{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
+{ $errors "Throws an error if the type does not exist or the requested size is negative." } 
+{ $see-also <malloc-array> } ;
+
+HELP: <c-object> "( n type -- array )"
+{ $values { "type" "a string" } { "array" "a byte array" } }
+{ $description "Creates a byte array suitable for holding a value with the given C type." }
+{ $errors "Throws an error if the type does not exist." }
+{ $see-also <malloc-object> } ;
+
+HELP: string>alien "( string -- array )"
+{ $values { "string" "a string" } { "array" "a byte array" } }
+{ $description "Copies the string to a new byte array, converting it to 8-bit ASCII and adding a trailing null byte." }
+{ $errors "Throws an error if the string contains null characters, or characters beyond the 8-bit range." } 
+{ $see-also alien>string <malloc-string> } ;
+
+HELP: alien>string "( c-ptr -- string )"
+{ $values { "c-ptr" "an alien, byte array or " { $link f } } { "string" "a string" } }
+{ $description "Reads a null-terminated 8-bit C string from the specified address." }
+{ $see-also string>alien } ;
+
+HELP: <malloc-array> "( n type -- alien )"
+{ $values { "n" "a non-negative integer" } { "type" "a string" } { "alien" "an alien address" } }
+{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type." }
+{ $warning "You must free blocks with a call to " { $link free } " when they are no longer needed." }
+{ $errors "Throws an error if the type does not exist, if the requested size is negative, or if memory allocation fails." }
+{ $see-also <c-array> } ;
+
+HELP: <malloc-object> "( type -- alien )"
+{ $values { "type" "a string" } { "alien" "an alien address" } }
+{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
+{ $warning "You must free blocks with a call to " { $link free } " when they are no longer needed." }
+{ $errors "Throws an error if the type does not exist or if memory allocation fails." } 
+{ $see-also <c-object> } ;
+
+HELP: <malloc-string> "( string -- alien )"
+{ $values { "string" "a string" } { "alien" "an alien address" } }
+{ $description "Copies a string to an unmanaged memory block large enough to hold a copy of the string in 8-bit ASCII encoding, with a trailing null byte." }
+{ $warning "You must free blocks with a call to " { $link free } " when they are no longer needed." }
+{ $errors "Throws an error if memory allocation fails." }
+{ $see-also string>alien } ;
+
+HELP: (typedef) "( old new -- )"
+{ $values { "old" "a string" } { "new" "a string" } }
+{ $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
+{ $notes "You should use the higher-level " { $link POSTPONE: TYPEDEF: } " word instead." }
+{ $see-also typedef POSTPONE: TYPEDEF: }  ;
+
+HELP: define-pointer "( type -- )"
+{ $values { "type" "a string" } }
+{ $description "Aliases the C type " { $snippet "type*" } " to " { $snippet "void*" } "." }
+{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+
+HELP: define-deref "( name vocab -- )"
+{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
+{ $description "Defines a word " { $snippet "*name" } " with stack effect " { $snippet "( c-ptr -- value )" } " for reading a value with C type " { $snippet "name" } " stored at an alien pointer." }
+{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+
+HELP: define-nth "( name vocab -- )"
+{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
+{ $description "Defines a word " { $snippet { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( n c-ptr -- value )" } " for reading the value with C type " { $snippet "name" } " stored at an alien pointer, displaced by a multiple of the C type's size." }
+{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+
+HELP: define-set-nth "( name vocab -- )"
+{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
+{ $description "Defines a word " { $snippet "set-" { $emphasis "name" } "-nth" } " with stack effect " { $snippet "( value n c-ptr -- )" } " for writing the value with C type " { $snippet "name" } " to an alien pointer, displaced by a multiple of the C type's size." }
+{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+
+HELP: define-out "( name vocab -- )"
+{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } }
+{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
+{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
+
+HELP: typedef "( old new -- )"
+{ $values { "old" "a string" } { "new" "a string" } }
+{ $description "Alises the C types " { $snippet "old" } " and " { $snippet "old*" } " under the names " { $snippet "new" } " and " { $snippet "new*" } ", respectively." }
+{ $notes "You should use the higher-level " { $link POSTPONE: TYPEDEF: } " word instead." }
+{ $see-also (typedef) POSTPONE: TYPEDEF: } ;

library/bootstrap/boot-stage1.factor

@@ -90,6 +90,7 @@ vectors words ;
         "/library/help/markup.factor"
         "/library/help/word-help.factor"
         "/library/help/syntax.factor"
+        "/library/help/crossref.factor"
         
         "/library/tools/describe.factor"
         "/library/tools/debugger.factor"
@@ -194,6 +195,10 @@ vectors words ;
         "/library/threads.facts"
         "/library/vocabularies.facts"
         "/library/words.facts"
+        "/library/alien/alien-callback.facts"
+        "/library/alien/alien-invoke.facts"
+        "/library/alien/aliens.facts"
+        "/library/alien/c-types.facts"
         "/library/bootstrap/image.facts"
         "/library/collections/growable.facts"
         "/library/collections/arrays.facts"

library/help/crossref.factor

@@ -0,0 +1,56 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+IN: help
+USING: arrays generic hashtables io kernel lists namespaces
+sequences strings words ;
+
+: all-articles ( -- seq )
+    [
+        articles hash-keys %
+        [ word-article ] word-subset %
+        terms get hash-keys [ <term> ] map %
+    ] { } make ;
+
+: sort-articles ( seq -- assoc )
+    [ [ article-title ] keep 2array ] map
+    [ [ first ] 2apply <=> ] sort
+    [ second ] map ;
+
+: each-article ( quot -- ) all-articles swap each ; inline
+
+GENERIC: elements* ( elt-type element -- )
+
+M: simple-element elements* [ elements* ] each-with ;
+
+M: object elements* 2drop ;
+
+M: array elements*
+    [ [ elements* ] each-with ] 2keep
+    [ first eq? ] keep swap [ , ] [ drop ] if ;
+
+: elements ( elt-type element -- seq ) [ elements* ] { } make ;
+
+: collect-elements ( elt-type article -- )
+    elements [ 1 swap tail [ dup set ] each ] each ; inline
+
+: links-out ( article -- seq )
+    article-content [
+        \ $link over collect-elements
+        \ $see-also over collect-elements
+        \ $subsection swap collect-elements
+    ] make-hash hash-keys ;
+
+: links-in ( article -- seq )
+    all-articles [ links-out member? ] subset-with ;
+
+: help-outliner ( seq quot -- | quot: obj -- )
+    swap sort-articles [ ($subsection) terpri ] each-with ;
+
+: articles. ( -- )
+    articles get hash-keys [ help ] help-outliner ;
+
+: links-out. ( article -- )
+    links-out [ links-out. ] help-outliner ;
+
+: links-in. ( article -- )
+    links-in [ links-in. ] help-outliner ;

library/help/help.factor

@@ -21,3 +21,7 @@ DEFER: $heading
 : handbook ( -- ) "handbook" help ;
     
 : tutorial ( -- ) "tutorial" help ;
+
+: articles. ( -- )
+    
+    ;

library/help/markup.factor

@@ -122,14 +122,14 @@ M: link article-content link-name article-content ;
 
 DEFER: help
 
+: ($subsection) ( quot object -- )
+    subsection-style [
+        [ swap curry ] keep dup article-title swap <link>
+        rot simple-outliner
+    ] with-style ;
+
 : $subsection ( object -- )
-    [
+    [ first [ (help) ] swap ($subsection) ] ($block) ;
-        subsection-style [
-            first dup article-title swap <link>
-            dup [ link-name (help) ] curry
-            simple-outliner
-        ] with-style
-    ] ($block) ;
 
 : $link ( article -- )
     last-block off first dup word? [

library/help/word-help.factor

@@ -7,8 +7,10 @@ M: word article-title "The " swap word-name " word" append3 ;
 
 M: word article-name word-name ;
 
+: word-article ( word -- article ) "help" word-prop ;
+
 : word-help ( word -- )
-    dup "help" word-prop [
+    dup word-article [
         % drop
     ] [
         "predicating" word-prop [

library/test/inspector.factor

@@ -2,15 +2,8 @@ IN: temporary
 USING: kernel inspector math namespaces prettyprint test
 sequences ;
 
-V{ } clone inspector-stack set
+[ 1 2 3 ] describe
-
+f describe
-[[ "hello" "world" ]] (inspect)
+\ + describe
-
+H{ } describe
-[ "hello" ] [ 0 inspector-slots get nth ] unit-test
-[ "world" ] [ 1 inspector-slots get nth ] unit-test
-
-[ 1 2 3 ] (inspect)
-f (inspect)
-\ + (inspect)
-H{ } (inspect)
 H{ } describe

library/ui/browser.factor

@@ -18,10 +18,13 @@ H{ } clone components set-global
     { "Definition" [ help ] }
     { "Calls in" [ usage. ] }
     { "Calls out" [ uses. ] }
+    { "Links out" [ links-out. ] }
+    { "Vocabulary" [ word-vocabulary words. ] }
 } \ word components get-global set-hash
 
 {
-    { "Documentation" [ help ] }
+    { "Article" [ help ] }
+    { "Links out" [ links-out. ] }
 } \ link components get-global set-hash
 
 TUPLE: book page pages ;

library/ui/buttons.factor

@@ -18,11 +18,12 @@ TUPLE: button rollover? pressed? quot ;
 
 : button-update ( button -- )
     dup mouse-over? over set-button-rollover?
-    dup mouse-clicked? button-down? and over set-button-pressed?
+    dup mouse-clicked? button-down? and
+    over button-rollover? and over set-button-pressed?
     relayout-1 ;
 
 : if-clicked ( button quot -- )
-    >r dup button-update dup button-rollover? r> when drop ;
+    >r dup button-update dup button-rollover? r> [ drop ] if ;
 
 : button-clicked ( button -- )
     dup button-quot if-clicked ;

library/ui/launchpad.factor

@@ -22,6 +22,7 @@ namespaces sequences ;
     {
         { "Listener" [ listener-window ] }
         { "Documentation" [ handbook-window ] }
+        { "Help index" [ [ articles. ] "Help index" pane-window ] }
         { "Tutorial" [ tutorial-window ] }
         { "Vocabularies" [ [ vocabs. ] "Vocabularies" pane-window ] }
         { "Globals" [ global browser-window ] }

library/words.factor

@@ -46,7 +46,7 @@ SYMBOL: crossref
 : (add-crossref) crossref get [ dupd nest set-hash ] bind ;
 
 : add-crossref ( word -- )
-    crossref get over word-vocabulary and [
+    crossref get over interned? and [
         dup dup uses [ (add-crossref) ] each-with
     ] when drop ;