extra/ui/tools/browser/browser.factor

   1 ! Copyright (C) 2006, 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: debugger ui.tools.workspace help help.topics kernel
   4 models ui.commands ui.gadgets ui.gadgets.panes
   5 ui.gadgets.scrollers ui.gadgets.tracks ui.gestures
   6 ui.gadgets.buttons ;
   7 IN: ui.tools.browser
   8
   9 TUPLE: browser-gadget pane history ;
  10
  11 : show-help ( link help -- )
  12     dup browser-gadget-history add-history
  13     >r >link r> browser-gadget-history set-model ;
  14
  15 : <help-pane> ( browser-gadget -- gadget )
  16     browser-gadget-history
  17     [ [ dup help ] try drop ] <pane-control> ;
  18
  19 : init-history ( browser-gadget -- )
  20     "handbook" <history>
  21     swap set-browser-gadget-history ;
  22
  23 : <browser-gadget> ( -- gadget )
  24     browser-gadget construct-empty
  25     dup init-history [
  26         toolbar,
  27         g <help-pane> g-> set-browser-gadget-pane
  28         <scroller> 1 track,
  29     ] { 0 1 } build-track ;
  30
  31 M: browser-gadget call-tool* show-help ;
  32
  33 M: browser-gadget tool-scroller
  34     browser-gadget-pane find-scroller ;
  35
  36 : help-action ( browser-gadget -- link )
  37     browser-gadget-history model-value >link ;
  38
  39 : com-follow browser-gadget call-tool ;
  40
  41 : com-back browser-gadget-history go-back ;
  42
  43 : com-forward browser-gadget-history go-forward ;
  44
  45 : com-documentation "handbook" swap show-help ;
  46
  47 : com-vocabularies "vocab-index" swap show-help ;
  48
  49 : browser-help "ui-browser" help-window ;
  50
  51 \ browser-help H{ { +nullary+ t } } define-command
  52
  53 browser-gadget "toolbar" f {
  54     { T{ key-down f { A+ } "b" } com-back }
  55     { T{ key-down f { A+ } "f" } com-forward }
  56     { T{ key-down f { A+ } "h" } com-documentation }
  57     { T{ key-down f { A+ } "v" } com-vocabularies }
  58     { T{ key-down f f "F1" } browser-help }
  59 } define-command-map