Browser cleanups, moving assoc word from lists to sequences

slava 2006-03-25 03:02:50 +00:00
parent fdfcc34621
commit 38602d63b9
6 changed files with 32 additions and 40 deletions

View File

@ -166,12 +166,12 @@ vectors words ;
"/library/ui/gadgets.factor"
"/library/ui/layouts.factor"
"/library/ui/hierarchy.factor"
"/library/ui/frames.factor"
"/library/ui/world.factor"
"/library/ui/paint.factor"
"/library/ui/theme.factor"
"/library/ui/labels.factor"
"/library/ui/gestures.factor"
"/library/ui/frames.factor"
"/library/ui/borders.factor"
"/library/ui/buttons.factor"
"/library/ui/line-editor.factor"
@ -183,6 +183,7 @@ vectors words ;
"/library/ui/paragraphs.factor"
"/library/ui/panes.factor"
"/library/ui/outliner.factor"
"/library/ui/environment.factor"
"/library/ui/listener.factor"
"/library/ui/browser.factor"
"/library/ui/launchpad.factor"

View File

@ -79,8 +79,6 @@ M: cons = ( obj cons -- ? )
: curry ( obj quot -- quot ) >r literalize r> cons ;
: assoc ( key alist -- value ) [ car = ] find-with nip cdr ;
: (>list) ( n i seq -- list )
pick pick <= [
3drop [ ]

View File

@ -106,6 +106,9 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
pick over bounds-check 2drop 2dup bounds-check 2drop
exchange-unsafe ;
: assoc ( key assoc -- value )
[ first = ] find-with nip second ;
IN: kernel
M: object <=>

View File

@ -37,7 +37,7 @@ TUPLE: rstate label base-case? ;
r> current-node set ;
: with-recursive-state ( word label base-case quot -- )
>r <rstate> cons recursive-state [ cons ] change r>
>r <rstate> 2array recursive-state [ cons ] change r>
nest-node 2slip unnest-node ; inline
: inline-block ( word base-case -- node-block variables )

View File

@ -1,24 +1,21 @@
IN: components
USING: help inspector kernel namespaces sequences words ;
! Component document framework, like OpenDoc.
TUPLE: component name predicate builder ;
USING: hashtables help inspector kernel namespaces sequences
words ;
SYMBOL: components
V{ } clone components set-global
H{ } clone components set-global
: get-components ( obj -- seq )
components get-global
[ component-predicate call ] subset-with ;
: get-components ( class -- assoc )
components get-global hash [ { } ] unless*
{ "Slots" [ describe ] } append ;
: define-component ( name predicate builder -- )
<component> components get-global push ;
{
{ "Definition" [ help ] }
{ "Calls in" [ usage. ] }
{ "Calls out" [ uses. ] }
} word components get-global set-hash
"Slots" [ drop t ] [ describe ] define-component
"Documentation" [ word? ] [ help ] define-component
"Calls in" [ word? ] [ usage. ] define-component
"Calls out" [ word? ] [ uses. ] define-component
"Definition" [ term? ] [ help ] define-component
"Documentation" [ link? ] [ help ] define-component
{
{ "Documentation" [ help ] }
} link components get-global set-hash

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: gadgets-browser
USING: components gadgets gadgets-buttons gadgets-labels
USING: arrays components gadgets gadgets-buttons gadgets-labels
gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
hashtables help inspector kernel lists math namespaces
prettyprint sequences words ;
@ -10,39 +10,32 @@ TUPLE: book page pages ;
: show-page ( key book -- )
dup book-page unparent
[ book-pages hash ] keep
[ book-pages assoc ] keep
[ set-book-page ] 2keep
add-gadget ;
C: book ( page pages -- book )
C: book ( pages -- book )
dup delegate>gadget
[ set-book-pages ] keep
[ set-book-pages ] 2keep
[ >r first r> show-page ] keep
[ show-page ] keep ;
M: book pref-dim* ( book -- dim )
{ 0 0 0 } swap book-pages [ nip pref-dim vmax ] hash-each ;
book-pages { 0 0 0 } [ second pref-dim vmax ] reduce ;
M: book layout* ( book -- )
dup rect-dim swap book-page set-gadget-dim ;
: component-page ( obj component -- gadget )
component-builder make-pane <scroller> ;
: component-pages ( obj -- hash )
dup get-components [
[ component-name over ] keep component-page
] map>hash nip ;
: component-book ( hash -- book )
dup hash-keys natural-sort first swap <book> ;
: component-pages ( obj -- assoc )
dup get-components
[ first2 swapd make-pane <scroller> 2array ] map-with ;
: <tab> ( name book -- button )
dupd [ show-page ] curry curry
>r <label> r> <bevel-button> ;
: tabs ( hash book gadget -- )
>r swap hash-keys natural-sort
[ swap <tab> ] map-with r> add-gadgets ;
: tabs ( assoc book gadget -- )
>r swap [ first swap <tab> ] map-with r> add-gadgets ;
TUPLE: browser object history tabs ;
@ -52,7 +45,7 @@ TUPLE: browser object history tabs ;
: browse ( obj browser -- )
[ set-browser-object ] 2keep
dup browser-tabs clear-gadget
>r component-pages dup component-book r>
>r component-pages dup <book> r>
[ @center frame-add ] 2keep browser-tabs tabs ;
: find-browser [ browser? ] find-parent ;