1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs definitions fry help.topics kernel
4 colors.constants math.rectangles models.filter namespaces sequences
5 sorting definitions.icons ui.gadgets ui.gadgets.glass
6 ui.gadgets.labeled ui.gadgets.scrollers ui.gadgets.tables
7 ui.gadgets.search-tables ui.gadgets.wrappers ui.gestures ui.operations
8 ui.pens.solid ui.images ;
9 IN: ui.tools.browser.popups
11 SINGLETON: link-renderer
13 M: link-renderer row-columns
14 drop first2 [ definition-icon <image-name> ] dip 2array ;
16 M: link-renderer row-value drop first ;
18 TUPLE: links-popup < wrapper ;
20 : sorted-links ( links -- alist )
21 [ dup article-title ] { } map>assoc sort-values ;
23 : match? ( value str -- ? )
26 : <links-table> ( model quot -- table )
27 '[ @ sorted-links ] <filter>
28 link-renderer [ second ] <search-table>
29 [ invoke-primary-operation ] >>action
30 [ drop ] >>hook ! hide-glass ] >>hook
31 t >>selection-required?
37 : <links-popup> ( model quot title -- gadget )
38 [ <links-table> COLOR: white <solid> >>interior ] dip
39 <labeled-gadget> links-popup new-wrapper ;
42 { T{ key-down f f "ESC" } [ hide-glass ] }
47 : show-links-popup ( browser-gadget quot title -- )
48 [ dup model>> ] 2dip <links-popup>
49 [ hand-loc get { 0 0 } <rect> show-glass ] [ request-focus ] bi ;
51 : com-show-outgoing-links ( browser-gadget -- )
52 [ uses ] "Outgoing links" show-links-popup ;
54 : com-show-incoming-links ( browser-gadget -- )
55 [ usage ] "Incoming links" show-links-popup ;