core/ui/tools/browser.factor

   1 ! Copyright (C) 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays sequences kernel gadgets-panes definitions
   4 prettyprint gadgets-theme gadgets-borders gadgets
   5 generic gadgets-scrolling math io words models styles
   6 namespaces gadgets-tracks gadgets-presentations
   7 gadgets-workspace help gadgets-buttons tools ;
   8 IN: gadgets-browser
   9
  10 TUPLE: browser definitions ;
  11
  12 TUPLE: definitions showing ;
  13
  14 : find-definitions ( gadget -- definitions )
  15     [ definitions? ] find-parent ;
  16
  17 : definition-index ( definition definitions -- n )
  18     definitions-showing index ;
  19
  20 : close-definition ( gadget definition -- )
  21     over find-definitions definitions-showing delete
  22     unparent ;
  23
  24 : close-definitions ( definitions -- )
  25     dup clear-gadget definitions-showing delete-all ;
  26
  27 C: definitions ( -- gadget )
  28     <pile> over set-delegate
  29     { 2 2 } over set-pack-gap
  30     V{ } clone over set-definitions-showing ;
  31
  32 TUPLE: tile definition gadget ;
  33
  34 : find-tile [ tile? ] find-parent ;
  35
  36 : close-tile ( tile -- )
  37     dup tile-definition over find-definitions
  38     definitions-showing delete
  39     unparent ;
  40
  41 : <tile-content> ( definition -- gadget )
  42     [ [ see ] make-pane <default-border> ] keep
  43     unparse [ find-tile close-tile ] <closable-gadget>
  44     dup faint-boundary ;
  45
  46 C: tile ( definition -- gadget )
  47     over <tile-content> over set-gadget-delegate
  48     [ set-tile-definition ] keep ;
  49
  50 : show-definition ( definition definitions -- )
  51     2dup definition-index dup 0 >= [
  52         over nth-gadget swap scroll>rect drop
  53     ] [
  54         drop 2dup definitions-showing push
  55         swap <tile> over add-gadget
  56         scroll>bottom
  57     ] if ;
  58
  59 C: browser ( -- gadget )
  60     {
  61         {
  62             [ <definitions> ]
  63             set-browser-definitions
  64             [ <scroller> ]
  65             @center
  66         }
  67     } make-frame* ;
  68
  69 : clear-browser ( browser -- )
  70     browser-definitions close-definitions ;
  71
  72 browser "toolbar" {
  73     { "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
  74 } define-commands
  75
  76 M: browser call-tool*
  77     browser-definitions show-definition ;
  78
  79 M: browser tool-scroller browser-definitions find-scroller ;
  80
  81 M: browser tool-help drop "ui-browser" ;