steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Browser: keyboard navigation popups for A+k and A+K

db4
Slava Pestov 2009-02-17 08:29:57 -06:00
parent f12b163a7b
commit 51c89053c0
3 changed files with 63 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/ui/tools/browser/browser.factor
View File

@ -2,14 +2,15 @@
! See http://factorcode.org/license.txt for BSD license.
USING: debugger help help.topics help.crossref kernel models compiler.units
assocs words vocabs accessors fry combinators.short-circuit
sequences models models.history tools.apropos
sequences models models.history tools.apropos combinators
ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.tracks ui.gestures ui.gadgets.buttons ui.gadgets.packs
ui.gadgets.editors ui.gadgets.labels ui.gadgets.status-bar
ui.gadgets.borders ui.tools.common ui ;
ui.gadgets.glass ui.gadgets.borders ui.tools.common
ui.tools.browser.popups ui ;
IN: ui.tools.browser
TUPLE: browser-gadget < tool pane scroller search-field ;
TUPLE: browser-gadget < tool pane scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
@ -52,6 +53,13 @@ M: browser-gadget graft*
M: browser-gadget ungraft*
[ call-next-method ] [ remove-definition-observer ] bi ;
M: browser-gadget handle-gesture
{
{ [ over key-gesture? not ] [ call-next-method ] }
{ [ dup popup>> ] [ { [ pass-to-popup ] [ call-next-method ] } 2&& ] }
[ call-next-method ]
} cond ;
: showing-definition? ( defspec assoc -- ? )
{
[ key? ]
@ -115,6 +123,8 @@ browser-gadget "navigation" "Commands for navigating in the article hierarchy" {
{ T{ key-down f { A+ } "u" } com-up }
{ T{ key-down f { A+ } "p" } com-prev }
{ T{ key-down f { A+ } "n" } com-next }
{ T{ key-down f { A+ } "k" } com-show-outgoing-links }
{ T{ key-down f { A+ } "K" } com-show-incoming-links }
} define-command-map
browser-gadget "multi-touch" f {

1
basis/ui/tools/browser/popups/authors.txt Normal file
View File

@ -0,0 +1 @@
Slava Pestov

49
basis/ui/tools/browser/popups/popups.factor Normal file
View File

@ -0,0 +1,49 @@
! 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 ;