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 gadgets-grids
7 gadgets-workspace gadgets-frames help gadgets-buttons
11 TUPLE: browser navigator definitions search ;
13 TUPLE: definitions showing ;
15 : find-definitions ( gadget -- definitions )
16 [ definitions? ] find-parent ;
18 : definition-index ( definition definitions -- n )
19 definitions-showing index ;
21 : close-definition ( gadget definition -- )
22 over find-definitions definitions-showing delete
25 : close-definitions ( definitions -- )
26 dup clear-gadget definitions-showing delete-all ;
28 C: definitions ( -- gadget )
29 <pile> over set-delegate
30 { 2 2 } over set-pack-gap
31 V{ } clone over set-definitions-showing ;
33 TUPLE: tile definition gadget ;
35 : find-tile [ tile? ] find-parent ;
37 : close-tile ( tile -- )
38 dup tile-definition over find-definitions
39 definitions-showing delete
42 : <tile-content> ( definition toolbar -- gadget )
43 >r [ see ] make-pane r> 2array
44 make-pile { 5 5 } over set-pack-gap
45 <default-border> dup faint-boundary ;
47 C: tile ( definition -- gadget )
48 2dup { tile } <toolbar>
49 <tile-content> over set-gadget-delegate
50 [ set-tile-definition ] keep ;
52 : show-definition ( definition definitions -- )
53 2dup definition-index dup 0 >= [
54 over nth-gadget swap scroll>rect drop
56 drop 2dup definitions-showing push
57 swap <tile> over add-gadget
61 : <list-control> ( model quot -- gadget )
62 [ map [ first2 write-object terpri ] each ] curry
65 TUPLE: navigator vocab ;
67 : <vocab-list> ( -- gadget )
68 vocabs <model> [ dup <vocab-link> 2array ]
71 : <word-list> ( model -- gadget )
72 gadget get navigator-vocab
73 [ words natural-sort ] <filter>
74 [ dup word-name swap 2array ]
77 C: navigator ( -- gadget )
78 f <model> over set-navigator-vocab
80 { [ <vocab-list> ] f [ <scroller> ] 1/2 }
81 { [ <word-list> ] f [ <scroller> ] 1/2 }
82 } { 1 0 } make-track* ;
84 C: browser ( -- gadget )
94 set-browser-definitions
99 [ "" [ browser call-tool ] <word-search> ]
104 } { 0 1 } make-track* ;
106 M: browser focusable-child* browser-search ;
108 : show-vocab ( vocab browser -- )
109 browser-navigator navigator-vocab set-model* ;
111 : show-word ( word browser -- )
112 over word-vocabulary over show-vocab
113 browser-definitions show-definition ;
115 : clear-browser ( browser -- )
116 browser-definitions close-definitions ;
119 { "Clear" T{ key-down f f "CLEAR" } [ clear-browser ] }
122 M: browser call-tool*
124 >r vocab-link-name r> show-vocab
129 M: browser tool-scroller browser-definitions find-scroller ;
131 M: browser tool-help drop "ui-browser" ;