50 lines
1.5 KiB
Factor
50 lines
1.5 KiB
Factor
|
! Copyright (C) 2009 Slava Pestov.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: accessors arrays assocs definitions fry help.topics kernel
|
||
|
|
colors.constants math.rectangles models.filter namespaces sequences
|
||
|
|
sorting ui.gadgets ui.gadgets.glass ui.gadgets.labeled
|
||
|
|
ui.gadgets.scrollers ui.gadgets.tables ui.gadgets.search-tables
|
||
|
|
ui.gadgets.wrappers ui.gestures ui.operations ui.pens.solid ;
|
||
|
|
IN: ui.tools.browser.popups
|
||
|
|
|
||
|
|
SINGLETON: link-renderer
|
||
|
|
|
||
|
|
M: link-renderer row-columns drop second 1array ;
|
||
|
|
|
||
|
|
M: link-renderer row-value drop first ;
|
||
|
|
|
||
|
|
TUPLE: links-popup < wrapper ;
|
||
|
|
|
||
|
|
: sorted-links ( links -- alist )
|
||
|
|
[ dup article-title ] { } map>assoc sort-values ;
|
||
|
|
|
||
|
|
: match? ( value str -- ? )
|
||
|
|
swap second subseq? ;
|
||
|
|
|
||
|
|
: <links-table> ( model quot -- table )
|
||
|
|
'[ @ sorted-links ] <filter>
|
||
|
|
link-renderer [ second ] <search-table>
|
||
|
|
[ invoke-primary-operation ] >>action
|
||
|
|
dup '[ _ hide-glass ] >>hook
|
||
|
|
t >>selection-required? ;
|
||
|
|
|
||
|
|
: <links-popup> ( model quot title -- gadget )
|
||
|
|
[ <links-table> COLOR: white <solid> >>interior ] dip
|
||
|
|
<labeled-gadget> links-popup new-wrapper ;
|
||
|
|
|
||
|
|
links-popup H{
|
||
|
|
{ T{ key-down f f "ESC" } [ hide-glass ] }
|
||
|
|
} set-gestures
|
||
|
|
|
||
|
|
SLOT: model
|
||
|
|
|
||
|
|
: show-links-popup ( browser-gadget quot title -- )
|
||
|
|
[ dup model>> ] 2dip <links-popup>
|
||
|
|
[ hand-loc get { 0 0 } <rect> show-glass ] [ request-focus ] bi ;
|
||
|
|
|
||
|
|
: com-show-outgoing-links ( browser-gadget -- )
|
||
|
|
[ uses ] "Outgoing links" show-links-popup ;
|
||
|
|
|
||
|
|
: com-show-incoming-links ( browser-gadget -- )
|
||
|
|
[ usage ] "Incoming links" show-links-popup ;
|