From 81cbf71d278e85807df527e58f3ae4dd73c28667 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Sun, 16 Aug 2015 11:32:54 -0700 Subject: [PATCH] help: make the default print prev/next links but then modify ui.tools.browser to do what it used to do. --- basis/help/help.factor | 42 ++++++++++------------ basis/help/html/html.factor | 25 +------------ basis/ui/tools/browser/browser.factor | 52 ++++++++++++++++++++++----- 3 files changed, 63 insertions(+), 56 deletions(-) diff --git a/basis/help/help.factor b/basis/help/help.factor index 2dfdb85c1f..a61528347e 100644 --- a/basis/help/help.factor +++ b/basis/help/help.factor @@ -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 diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 6dc625a422..192be5f06a 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -85,35 +85,12 @@ M: pathname url-of 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 ; diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index a0f3c415f7..3b524bcdc1 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -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 ; + : ( browser-gadget -- gadget ) model>> [ '[ _ $title ] try ] ; @@ -53,6 +84,11 @@ M: browser-gadget set-history-value dupd swap next 1 track-add f track-add ; +: print-topic ( topic -- ) + >link + last-element off + article-content print-content ; + : ( browser-gadget -- gadget ) model>> [ '[ _ print-topic ] try ] ;