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

Minor UI cleanup

darcs
slava 2006-07-11 04:57:46 +00:00
parent 5f7ad40ade
commit 337219be0d
5 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
library/ui/gadgets.factor
View File

@ -96,3 +96,8 @@ M: gadget gadget-help drop f ;
: with-gadget ( gadget quot -- ) : with-gadget ( gadget quot -- )
[ swap gadget set call ] with-scope ; inline [ swap gadget set call ] with-scope ; inline
! Title bar protocol
GENERIC: gadget-title ( gadget -- string )
M: gadget gadget-title drop "Factor" <model> ;

7
library/ui/ui.factor
View File

@ -53,12 +53,6 @@ SYMBOL: windows
: <status-bar> ( -- gadget ) "" <label> dup highlight-theme ; : <status-bar> ( -- gadget ) "" <label> dup highlight-theme ;
GENERIC: gadget-title ( gadget -- string )
M: gadget gadget-title drop "Factor" <model> ;
M: world gadget-title world-gadget gadget-title ;
TUPLE: titled-gadget title ; TUPLE: titled-gadget title ;
M: titled-gadget gadget-title titled-gadget-title ; M: titled-gadget gadget-title titled-gadget-title ;
@ -76,7 +70,6 @@ C: titled-gadget ( gadget title -- )
: open-window ( gadget -- ) : open-window ( gadget -- )
<world> dup init-status <world> dup init-status
dup pref-dim over set-gadget-dim dup pref-dim over set-gadget-dim
dup world-gadget gadget-title over set-world-title
dup open-window* dup open-window*
draw-world ; draw-world ;

8
library/ui/world.factor
View File

@ -23,13 +23,13 @@ TUPLE: world gadget title status focus focused? fonts handle loc ;
DEFER: request-focus DEFER: request-focus
C: world ( gadget -- world ) C: world ( gadget -- world )
f <model> over set-world-title
f <model> over set-world-status f <model> over set-world-status
[ >r dup gadget-title r> set-world-title ] keep
{ { f set-world-gadget f @center } } make-frame* { { f set-world-gadget f @center } } make-frame*
t over set-gadget-root? t over set-gadget-root?
H{ } clone over set-world-fonts H{ } clone over set-world-fonts
dup world-gadget request-focus { 0 0 } over set-world-loc
{ 0 0 } over set-world-loc ; dup world-gadget request-focus ;
: find-world [ world? ] find-parent ; : find-world [ world? ] find-parent ;
@ -63,3 +63,5 @@ M: world model-changed ( world -- )
: draw-string ( font string -- ) : draw-string ( font string -- )
>r world get font-sprites first2 r> (draw-string) ; >r world get font-sprites first2 r> (draw-string) ;
M: world gadget-title world-gadget gadget-title ;

5
library/ui/x11/ui.factor
View File

@ -132,8 +132,9 @@ IN: gadgets
world-handle first dpy get -rot swap XStoreName drop ; world-handle first dpy get -rot swap XStoreName drop ;
: open-window* ( world -- ) : open-window* ( world -- )
dup gadget-window dup start-world dup gadget-window
world-handle first map-window* ; dup start-world
world-handle first dup set-closable map-window ;
: raise-window ( world -- ) : raise-window ( world -- )
dpy get swap world-handle first XRaiseWindow drop ; dpy get swap world-handle first XRaiseWindow drop ;

2
library/ui/x11/windows.factor
View File

@ -60,6 +60,4 @@ USING: alien gadgets hashtables kernel math namespaces sequences ;
: map-window ( win -- ) dpy get swap XMapWindow drop ; : map-window ( win -- ) dpy get swap XMapWindow drop ;
: map-window* ( world win -- ) dup set-closable map-window ;
: unmap-window ( win -- ) dpy get swap XUnmapWindow drop ; : unmap-window ( win -- ) dpy get swap XUnmapWindow drop ;