Improved help cross-referencing

doc/handbook/collections.facts

@@ -21,7 +21,7 @@ ARTICLE: "queues" "Queues"
 { $subsection deque }
 { $subsection enque }
 "An example:"
-{ $snippet
+{ $code
     "<queue> \"q\" set"
     "5 \"q\" get enque"
     "3 \"q\" get enque"

doc/handbook/conventions.facts

@@ -31,4 +31,8 @@ ARTICLE: "conventions" "Conventions"
     { { $snippet "set-" { $emphasis "foo" } "-" { $emphasis "bar" } } { "(tuple mutators) sets the value of the " { $snippet "bar" } " slot of the " { $snippet "foo" } " at the top of the stack" } { } }
     { { $snippet "with-" { $emphasis "foo" } } { "performs some kind of initialization and cleanup related to " { $snippet "foo" } ", usually in a new dynamic scope" } { $links with-scope with-stream } }
     { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
-} ;
+}
+{ $heading "Vocabulary naming conventions" }
+"A vocabulary name ending in " { $snippet "-internals" } " contains words which are either implementation detail, unsafe, or both. For example, the " { $snippet "sequence-internals" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } ")."
+$terpri
+"You should should avoid using internal words from the Factor library unless absolutely necessary. In your own code, place words in internal vocabularies if you do not want other people to use them unless they have a good reason." ;

library/bootstrap/boot-stage2.factor

@@ -9,7 +9,6 @@ parser sequences sequences-internals words ;
 [
     "Cross-referencing..." print flush
     H{ } clone crossref set-global xref-words
-    H{ } clone parent-graph set-global xref-articles
 
     "compile" get [
         "native-io" get [
@@ -59,7 +58,8 @@ parser sequences sequences-internals words ;
     ] when
         
     "Building online help search index..." print flush
-    index-help
+    H{ } clone parent-graph set-global xref-help
+    H{ } clone term-index set-global index-help
     
     [
         boot

library/bootstrap/image.factor

@@ -291,7 +291,7 @@ M: hashtable ' ( hashtable -- pointer )
     [
         {
             vocabularies typemap builtins c-types crossref
-            articles parent-graph
+            articles parent-graph term-index
         } [ dup get swap bootstrap-word set ] each
     ] make-hash '
     global-offset fixup ;

library/bootstrap/primitives.factor

@@ -22,6 +22,7 @@ vocabularies get [ "syntax" set ] bind
 
 H{ } clone articles set
 parent-graph off
+term-index off
 crossref off
 
 ! Call the quotation parsed from primitive-types.factor

library/help/help.factor

@@ -9,7 +9,7 @@ M: word article-title
 M: word article-content
     [
         \ $vocabulary over 2array ,
-        dup "help" word-prop [
+        dup word-help [
             %
         ] [
             "predicating" word-prop [

library/help/markup.factor

@@ -122,7 +122,7 @@ M: word print-element { } swap execute ;
 ! Some links
 M: link article-title link-name article-title ;
 M: link article-content link-name article-content ;
-M: link summary "Link: " swap link-name append ;
+M: link summary "Link: " swap link-name unparse append ;
 
 : >link ( obj -- obj ) dup word? [ <link> ] unless ;
 

library/help/search.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: help
 USING: arrays graphs hashtables help io kernel math namespaces
-porter-stemmer prettyprint sequences strings ;
+porter-stemmer prettyprint sequences strings words ;
 
 ! Right now this code is specific to the help. It will be
 ! generalized to an abstract full text search engine later.
@@ -20,11 +20,22 @@ porter-stemmer prettyprint sequences strings ;
 : index-text ( article string -- )
     tokenize [ 1 -rot nest hash+ ] each-with ;
 
-: index-article ( article -- )
-    dup [ help ] string-out index-text ;
-
 SYMBOL: term-index
 
+: index-article ( article -- )
+    term-index get [
+        [ dup [ help ] string-out index-text ] bind
+    ] [
+        drop
+    ] if* ;
+
+: unindex-article ( article -- )
+    term-index get [
+        [ nip remove-hash ] hash-each-with
+    ] [
+        drop
+    ] if* ;
+
 : discard-irrelevant ( results -- results )
     #! Discard results in the low 33%
     dup 0 [ second max ] reduce
@@ -44,11 +55,33 @@ SYMBOL: term-index
     [ [ second ] 2apply swap - ] sort discard-irrelevant ;
 
 : index-help ( -- )
-    [ all-articles [ index-article ] each ] make-hash
+    term-index get [
-    term-index set-global ;
+        dup clear-hash
+        [ all-articles [ index-article ] each ] bind
+    ] when* ;
+
+: remove-article ( name -- )
+    dup articles get hash-member? [
+        dup unxref-article
+        dup unindex-article
+        dup articles get remove-hash
+    ] when drop ;
 
 : add-article ( name title element -- )
-    (add-article) ;
+    pick remove-article
+    pick >r (add-article) r>
+    dup xref-article index-article ;
+
+: remove-word-help ( word -- )
+    dup word-help [
+        dup unxref-article
+        dup unindex-article
+    ] when drop ;
+
+: set-word-help ( word content -- )
+    over remove-word-help
+    over >r "help" set-word-prop r>
+    dup xref-article index-article ;
 
 : search-help. ( phrase -- )
     "Search results for ``" write dup write "'':" print

library/help/syntax.factor

@@ -5,8 +5,9 @@ USING: arrays help kernel parser sequences syntax words ;
 
 : !HELP:
     scan-word bootstrap-word dup [
-        >array unclip swap >r "stack-effect" set-word-prop r>
+        >array unclip swap
-        "help" set-word-prop
+        >r "stack-effect" set-word-prop r>
+        set-word-help
     ] f ; parsing
 
 : !ARTICLE:

library/help/topics.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: help
-USING: arrays errors graphs hashtables io kernel namespaces
+USING: arrays errors generic graphs hashtables io kernel
-sequences strings words ;
+namespaces prettyprint sequences words ;
 
 ! Markup
 GENERIC: print-element
@@ -14,13 +14,13 @@ TUPLE: article title content ;
 
 : article ( name -- article )
     dup articles get hash
-    [ ] [ "No such article: " swap append throw ] ?if ;
+    [ ] [ "No such article: " swap unparse append throw ] ?if ;
 
 : (add-article) ( name title element -- )
     <article> swap articles get set-hash ;
 
-M: string article-title article article-title ;
+M: object article-title article article-title ;
-M: string article-content article article-content ;
+M: object article-content article article-content ;
 
 ! Special case: f help
 M: f article-title drop \ f article-title ;
@@ -28,8 +28,11 @@ M: f article-content drop \ f article-content ;
 
 TUPLE: link name ;
 
+: word-help ( word -- content ) "help" word-prop ;
+
 : all-articles ( -- seq )
-    articles get hash-keys all-words append ;
+    articles get hash-keys
+    all-words [ word-help ] subset append ;
 
 GENERIC: elements* ( elt-type element -- )
 
@@ -67,5 +70,5 @@ DEFER: $subsection
 : unxref-article ( article -- )
     [ children ] parent-graph get remove-vertex ;
 
-: xref-articles ( -- )
+: xref-help ( -- )
     all-articles [ children ] parent-graph get build-graph ;

library/help/topics.facts

@@ -21,7 +21,7 @@ HELP: article-content "( topic -- element )"
 { $description "Outputs the content of a specific help article." } ;
 
 HELP: (add-article) "( name title element -- )"
-{ $values { "name" "a string" } { "title" "a string" } { "element" "a markup element" } }
+{ $values { "name" "an object" } { "title" "a string" } { "element" "a markup element" } }
 { $description "Adds a help article to the " { $link articles } " hashtable." }
 { $notes "This word is used to implement " { $link POSTPONE: ARTICLE: } "." } ;
 
@@ -40,7 +40,7 @@ HELP: collect-elements "( element seq -- )"
 
 HELP: parent-graph f
 { $description "Variable. A graph whose vertices are help articles and edges are subsections. See " { $link "graphs" } "." }
-{ $see-also children parents xref-articles } ;
+{ $see-also children parents xref-help } ;
 
 HELP: children "( topic -- seq )"
 { $values { "topic" "an article name or a word" } { "seq" "a new sequence" } }
@@ -67,5 +67,5 @@ HELP: unxref-article "( topic -- )"
 { $description "Removes an article to the " { $link parent-graph } " graph." }
 $low-level-note ;
 
-HELP: xref-articles "( -- )"
+HELP: xref-help "( -- )"
 { $description "Update the " { $link parent-graph } ". Usually this is done automatically." } ;

library/test/help/topics.factor

@@ -0,0 +1,24 @@
+IN: temporary
+USING: help kernel sequences test words ;
+
+! Test help cross-referencing
+
+{ "test" "b" } "Test B" { "Hello world." } add-article
+
+{ "test" "a" } "Test A" { { $subsection { "test" "b" } } } add-article
+
+{ "test" "a" } remove-article
+
+[ t ] [ { "test" "b" } parents empty? ] unit-test
+
+SYMBOL: foo
+
+{ "test" "a" } "Test A" { { $subsection foo } } add-article
+
+foo { $description "Fie foe fee" } set-word-help
+
+[ t ] [ "Fie" search-help [ first foo eq? ] contains? ] unit-test
+
+\ foo forget
+
+[ f ] [ "Fie" search-help [ first foo eq? ] contains? ] unit-test

library/test/test.factor

@@ -82,7 +82,7 @@ SYMBOL: failures
         "inference" "interpreter" "alien"
         "gadgets/line-editor" "gadgets/rectangles" "memory"
         "redefine" "annotate" "binary" "inspector"
-        "kernel" "help/porter-stemmer"
+        "kernel" "help/porter-stemmer" "help/topics"
     } run-tests ;
 
 : benchmarks

library/words.factor

@@ -1,5 +1,8 @@
 ! Copyright (C) 2004, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
+IN: help
+DEFER: remove-word-help
+
 IN: words
 USING: arrays errors graphs hashtables kernel kernel-internals
 math namespaces sequences strings vectors ;
@@ -151,6 +154,7 @@ SYMBOL: bootstrapping?
 
 : forget ( word -- )
     dup unxref-word
+    dup remove-word-help
     dup "forget-hook" word-prop call
     crossref get [ dupd remove-hash ] when*
     dup word-name swap word-vocabulary vocab remove-hash ;