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

Use icons in completion popups and vocab browser

db4
Slava Pestov 2009-02-11 04:55:49 -06:00
parent 66392108e7
commit bd5fb06cdf
2 changed files with 51 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
basis/tools/vocabs/browser/browser.factor
View File

@ -6,24 +6,24 @@ classes.singleton classes.tuple classes.union combinators
definitions effects fry generic help help.markup help.stylesheet
help.topics io io.files io.pathnames io.styles kernel macros
make namespaces prettyprint sequences sets sorting summary
tools.vocabs vocabs vocabs.loader words words.symbol ;
tools.vocabs vocabs vocabs.loader words words.symbol
combinators.smart definitions.icons ;
IN: tools.vocabs.browser
: vocab-status-string ( vocab -- string )
{
{ [ dup vocab not ] [ drop "" ] }
{ [ dup vocab-main ] [ drop "[Runnable]" ] }
[ drop "[Loaded]" ]
} cond ;
: <$definition> ( definition -- element )
[
[ definition-icon 1array \ $image prefix ]
[ drop " " ]
[ 1array \ $link prefix ] ! XXX
tri
] output>array ;
: vocab-row ( vocab -- row )
[ <$link> ] [ vocab-status-string ] [ vocab-summary ] tri
3array ;
[ <$definition> ] [ vocab-summary ] bi 2array ;
: vocab-headings ( -- headings )
{
{ $strong "Vocabulary" }
{ $strong "State" }
{ $strong "Summary" }
} ;
@ -82,7 +82,7 @@ C: <vocab-author> vocab-author
[
"Tuple classes" $subheading
[
[ <$link> ]
[ <$definition> ]
[ superclass <$link> ]
[ "slots" word-prop [ name>> ] map " " join <$snippet> ]
tri 3array
@ -95,7 +95,7 @@ C: <vocab-author> vocab-author
[
"Predicate classes" $subheading
[
[ <$link> ]
[ <$definition> ]
[ superclass <$link> ]
bi 2array
] map
@ -106,7 +106,7 @@ C: <vocab-author> vocab-author
: (describe-classes) ( classes heading -- )
'[
_ $subheading
[ <$link> 1array ] map $table
[ <$definition> 1array ] map $table
] unless-empty ;
: describe-builtin-classes ( classes -- )
@ -158,14 +158,16 @@ C: <vocab-author> vocab-author
$table
] unless-empty ;
: word-row ( word -- element )
[ <$definition> ]
[ stack-effect dup [ effect>string <$snippet> ] when ]
bi 2array ;
: word-headings ( -- element )
{ { $strong "Word" } { $strong "Stack effect" } } ;
: words-table ( words -- )
[
[ 1array \ $word-link prefix ]
[ stack-effect dup [ effect>string <$snippet> ] when ]
bi 2array
] map
{ { $strong "Word" } { $strong "Stack effect" } } prefix
$table ;
[ word-row ] map word-headings prefix $table ;
: (describe-words) ( words heading -- )
'[ _ $subheading words-table ] unless-empty ;

44
basis/ui/tools/listener/completion/completion.factor
View File

@ -1,15 +1,15 @@
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs calendar colors colors.constants documents
documents.elements fry kernel words sets splitting math math.vectors
models.delay models.filter combinators.short-circuit parser present
sequences tools.completion tools.vocabs.browser generic
generic.standard.engines.tuple fonts ui.commands ui.operations
ui.gadgets ui.gadgets.editors ui.gadgets.glass ui.gadgets.scrollers
ui.gadgets.tables ui.gadgets.tracks ui.gadgets.labelled
ui.gadgets.theme ui.gadgets.worlds ui.gadgets.wrappers ui.gestures
ui.render ui.tools.listener.history combinators vocabs
ui.tools.listener.popups ;
USING: accessors arrays assocs calendar colors colors.constants
documents documents.elements fry kernel words sets splitting math
math.vectors models.delay models.filter combinators.short-circuit
parser present sequences tools.completion tools.vocabs.browser generic
generic.standard.engines.tuple fonts definitions.icons ui.images
ui.commands ui.operations ui.gadgets ui.gadgets.editors
ui.gadgets.glass ui.gadgets.scrollers ui.gadgets.tables
ui.gadgets.tracks ui.gadgets.labelled ui.gadgets.theme
ui.gadgets.worlds ui.gadgets.wrappers ui.gestures ui.render
ui.tools.listener.history combinators vocabs ui.tools.listener.popups ;
IN: ui.tools.listener.completion
! We don't directly depend on the listener tool but we use a few slots
@ -25,14 +25,17 @@ TUPLE: word-completion vocabs ;
C: <word-completion> word-completion
SINGLETONS: vocab-completion char-completion history-completion ;
UNION: listener-completion word-completion vocab-completion char-completion history-completion ;
UNION: definition-completion word-completion vocab-completion ;
UNION: listener-completion definition-completion char-completion history-completion ;
GENERIC: completion-quot ( interactor completion-mode -- quot )
M: word-completion completion-quot 2drop [ [ { } ] [ words-matching ] if-empty ] ;
M: vocab-completion completion-quot 2drop [ [ { } ] [ vocabs-matching ] if-empty ] ;
M: char-completion completion-quot 2drop [ [ { } ] [ chars-matching ] if-empty ] ;
: (completion-quot) ( interactor completion-mode quot -- quot' )
2nip '[ [ { } ] _ if-empty ] ; inline
M: word-completion completion-quot [ words-matching ] (completion-quot) ;
M: vocab-completion completion-quot [ vocabs-matching ] (completion-quot) ;
M: char-completion completion-quot [ chars-matching ] (completion-quot) ;
M: history-completion completion-quot drop '[ drop _ history-list ] ;
GENERIC: completion-element ( completion-mode -- element )
@ -55,6 +58,15 @@ M: history-completion completion-popup-width drop dim>> first ;
! Completion modes also implement the row renderer protocol
M: listener-completion row-columns drop present 1array ;
M: definition-completion prototype-row
drop \ + definition-icon <image-name> "" 2array ;
M: definition-completion row-columns
drop
[ definition-icon <image-name> ]
[ present ] bi
2array ;
M: word-completion row-color
[ vocabulary>> ] [ vocabs>> ] bi* {
{ [ 2dup [ vocab-words ] dip memq? ] [ COLOR: black ] }
@ -133,6 +145,8 @@ GENERIC# accept-completion-hook 1 ( item popup -- )
>>renderer
monospace-font >>font
t >>selection-required?
transparent >>column-line-color
0 >>gap
dup '[ _ accept-completion ] >>action ;
: <completion-scroller> ( completion-popup -- scroller )