]> gitweb.factorcode.org Git - factor.git/commitdiff
help: make the default print prev/next links but then modify ui.tools.browser to...
authorJohn Benediktsson <mrjbq7@gmail.com>
Sun, 16 Aug 2015 18:32:54 +0000 (11:32 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Sun, 16 Aug 2015 18:33:24 +0000 (11:33 -0700)
basis/help/help.factor
basis/help/html/html.factor
basis/ui/tools/browser/browser.factor

index 2dfdb85c1f92e0fec3eba9730e5068a3fd91d264..a61528347ed0dcd37052a44fa002a5eae7b59c46 100644 (file)
@@ -97,45 +97,39 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
 
 : ($title) ( topic -- )
     [ [ article-title ] [ >link ] bi write-object ] ($block) ;
-    
-CONSTANT: prev -1
-CONSTANT: next 1
-
-: add-navigation-arrow ( str direction -- str )
-    prev = [ "<" prefix ] [ ">" suffix ] if ;
-
-: $navigation-row ( content element direction -- )
-    [ prefix 1array ] dip add-navigation-arrow , ;
 
 : ($navigation-table) ( element -- )
     help-path-style get table-style [ $table ] with-variable ;
 
-:: ($navigation) ( topic direction -- )
-    topic [ direction prev/next-article
-      [ 1array \ $long-link direction $navigation-row ] when* ] 
-    { } make [ ($navigation-table) ] unless-empty ;
-
 : ($navigation-path) ( topic -- )
-    help-path-style get
-       [ help-path [ reverse $breadcrumbs ] unless-empty ]
-    with-style ;
+    help-path-style get [
+       help-path [ reverse $breadcrumbs ] unless-empty
+    ] with-style ;
+
+: ($navigation-link) ( content element label -- )
+    [ prefix 1array ] dip prefix , ;
+
+: ($navigation-links) ( topic -- )
+    [
+        [ prev-article [ 1array \ $long-link "Prev:" ($navigation-link) ] when* ]
+        [ next-article [ 1array \ $long-link "Next:" ($navigation-link) ] when* ]
+        bi
+    ] { } make [ ($navigation-table) ] unless-empty ;
 
 : $title ( topic -- )
     title-style get [
         title-style get [
-            [ ($title) ] [ ($navigation-path) ] bi
+            [ ($title) ]
+            [ ($navigation-path) ]
+            [ ($navigation-links) ] tri
         ] with-nesting
     ] with-style ;
 
-:: $navigation ( topic direction -- )
-    topic title-style get 
-    [ help-path-style get [ direction ($navigation) ] with-style ]
-    with-style ;
-
 : print-topic ( topic -- )
     >link
     last-element off
-    article-content print-content ;
+    [ $title ($blank-line) ]
+    [ article-content print-content nl ] bi ;
 
 SYMBOL: help-hook
 
index 6dc625a422519327d8e6a866a34e35dcdc4d3a4a..192be5f06a7b179a00d7034e8c233babbc3f81e7 100644 (file)
@@ -85,35 +85,12 @@ M: pathname url-of
         </div>
      XML] ;
 
-: $navigation-row ( content element label -- )
-    [ prefix 1array ] dip prefix , ;
-
-: ($navigation-links) ( topic -- )
-    help-path-style get [
-        [
-            [ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ]
-            [ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
-            bi
-        ] { } make [ ($navigation-table) ] unless-empty
-    ] with-style ;
-
-: $title ( topic -- )
-    title-style get
-    { { page-color COLOR: FactorLightTan } } assoc-union dup
-    [
-        [
-            [ ($title) ]
-            [ ($navigation-path) ]
-            [ ($navigation-links) ] tri
-        ] with-nesting
-    ] with-style ;
-
 : help>html ( topic -- xml )
     [ article-title " - Factor Documentation" append ]
     [ drop help-stylesheet ]
     [
         [ help-navbar ]
-        [ [ [ $title ($blank-line) ] [ print-topic ] bi ] with-html-writer ]
+        [ [ print-topic ] with-html-writer ]
         bi* append
     ] tri
     simple-page ;
index a0f3c415f7bbdea6a9018a7611250d5c180fe74b..3b524bcdc1ac7a8e11e91f1efe3bda0161bba0af 100644 (file)
@@ -1,15 +1,16 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes colors colors.constants combinators
+USING: accessors arrays classes combinators
 combinators.short-circuit compiler.units debugger fry help
-help.apropos help.crossref help.home help.stylesheet help.topics
-kernel locals models sequences sets ui ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.buttons ui.gadgets.editors
-ui.gadgets.glass ui.gadgets.labels ui.gadgets.panes
-ui.gadgets.scrollers ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.toolbar
-ui.gadgets.packs ui.gadgets.theme ui.gadgets.viewports ui.gadgets.worlds ui.gestures
+help.apropos help.crossref help.home help.markup help.stylesheet
+help.topics io.styles kernel locals make models namespaces
+sequences sets ui ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.editors ui.gadgets.glass ui.gadgets.labels
+ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.status-bar
+ui.gadgets.theme ui.gadgets.toolbar ui.gadgets.tracks
+ui.gadgets.viewports ui.gadgets.worlds ui.gestures ui.pens.solid
 ui.tools.browser.history ui.tools.browser.popups ui.tools.common
-ui.pens.solid vocabs ;
+vocabs ;
 IN: ui.tools.browser
 
 TUPLE: browser-gadget < tool history scroller search-field popup ;
@@ -34,6 +35,36 @@ M: browser-gadget set-history-value
     [ set-control-value ]
     2bi ;
 
+CONSTANT: prev -1
+CONSTANT: next 1
+
+: add-navigation-arrow ( str direction -- str )
+    prev = [ "<" prefix ] [ ">" suffix ] if ;
+
+: $navigation-arrow ( content element direction -- )
+    [ prefix 1array ] dip add-navigation-arrow , ;
+
+:: ($navigation) ( topic direction -- )
+    topic [
+        direction prev/next-article
+        [ 1array \ $long-link direction $navigation-arrow ] when*
+    ] { } make [ ($navigation-table) ] unless-empty ;
+
+: $navigation ( topic direction -- )
+    title-style get [
+        help-path-style get [
+            ($navigation)
+        ] with-style
+    ] with-style ;
+
+: $title ( topic -- )
+    title-style get [
+        title-style get [
+            [ ($title) ]
+            [ ($navigation-path) ] bi
+        ] with-nesting
+    ] with-style ;
+
 : <help-header> ( browser-gadget -- gadget )
     model>> [ '[ _ $title ] try ] <pane-control> ;
 
@@ -53,6 +84,11 @@ M: browser-gadget set-history-value
     dupd swap next <help-footer> 1 track-add
     f track-add ;
 
+: print-topic ( topic -- )
+    >link
+    last-element off
+    article-content print-content ;
+
 : <help-pane> ( browser-gadget -- gadget )
     model>> [ '[ _ print-topic ] try ] <pane-control> ;