Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-09-01 19:05:37 -05:00
commit 47d5c24597
9 changed files with 38 additions and 37 deletions
basis
ui/cocoa
windows/time
extra
html/templates/chloe
springies/ui
x/widgets/wm/workspace

View File

@ -24,10 +24,10 @@ TUPLE: pasteboard handle ;
C: <pasteboard> pasteboard
M: pasteboard clipboard-contents
pasteboard-handle pasteboard-string ;
handle>> pasteboard-string ;
M: pasteboard set-clipboard-contents
pasteboard-handle set-pasteboard-string ;
handle>> set-pasteboard-string ;
: init-clipboard ( -- )
NSPasteboard -> generalPasteboard <pasteboard>
@ -44,29 +44,29 @@ M: pasteboard set-clipboard-contents
dup install-window-delegate
over -> release
<handle>
] keep set-world-handle ;
] keep (>>handle) ;
M: cocoa-ui-backend set-title ( string world -- )
world-handle handle-window swap <NSString> -> setTitle: ;
handle>> window>> swap <NSString> -> setTitle: ;
: enter-fullscreen ( world -- )
world-handle handle-view
handle>> view>>
NSScreen -> mainScreen
f -> enterFullScreenMode:withOptions:
drop ;
: exit-fullscreen ( world -- )
world-handle handle-view f -> exitFullScreenModeWithOptions: ;
handle>> view>> f -> exitFullScreenModeWithOptions: ;
M: cocoa-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend fullscreen* ( world -- ? )
world-handle handle-view -> isInFullScreenMode zero? not ;
handle>> view>> -> isInFullScreenMode zero? not ;
: auto-position ( world -- )
dup window-loc>> { 0 0 } = [
world-handle handle-window -> center
handle>> window>> -> center
] [
drop
] if ;
@ -74,29 +74,29 @@ M: cocoa-ui-backend fullscreen* ( world -- ? )
M: cocoa-ui-backend (open-window) ( world -- )
dup gadget-window
dup auto-position
world-handle handle-window f -> makeKeyAndOrderFront: ;
handle>> window>> f -> makeKeyAndOrderFront: ;
M: cocoa-ui-backend (close-window) ( handle -- )
handle-window -> release ;
window>> -> release ;
M: cocoa-ui-backend close-window ( gadget -- )
find-world [
world-handle [
handle-window f -> performClose:
handle>> [
window>> f -> performClose:
] when*
] when* ;
M: cocoa-ui-backend raise-window* ( world -- )
world-handle [
handle-window dup f -> orderFront: -> makeKeyWindow
handle>> [
window>> dup f -> orderFront: -> makeKeyWindow
NSApp 1 -> activateIgnoringOtherApps:
] when* ;
M: cocoa-ui-backend select-gl-context ( handle -- )
handle-view -> openGLContext -> makeCurrentContext ;
view>> -> openGLContext -> makeCurrentContext ;
M: cocoa-ui-backend flush-gl-context ( handle -- )
handle-view -> openGLContext -> flushBuffer ;
view>> -> openGLContext -> flushBuffer ;
M: cocoa-ui-backend beep ( -- )
NSBeep ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows windows.kernel32
namespaces calendar calendar.backend ;
namespaces calendar ;
IN: windows.time
: >64bit ( lo hi -- n )

View File

@ -53,7 +53,7 @@ M: mismatched summary ( obj -- str )
TUPLE: unclosed < parsing-error tags ;
: <unclosed> ( -- unclosed )
unclosed parsing-error
xml-stack get rest-slice [ first opener-name ] map >>tags ;
xml-stack get rest-slice [ first name>> ] map >>tags ;
M: unclosed summary ( obj -- str )
[
dup call-next-method write

View File

@ -49,7 +49,7 @@ SYMBOL: ns-stack
! Parsing names
: version=1.0? ( -- ? )
prolog-data get prolog-version "1.0" = ;
prolog-data get version>> "1.0" = ;
! version=1.0? is calculated once and passed around for efficiency
@ -69,7 +69,7 @@ SYMBOL: ns-stack
: (parse-entity) ( string -- )
dup entities at [ , ] [
prolog-data get prolog-standalone
prolog-data get standalone>>
[ <no-entity> throw ] [
dup extra-entities get at
[ , ] [ <no-entity> throw ] ?if

View File

@ -18,15 +18,15 @@ C: <q/a> q/a
: li>q/a ( li -- q/a )
[ "br" tag-named*? not ] filter
[ "strong" tag-named*? ] find-after
>r tag-children r> <q/a> ;
>r children>> r> <q/a> ;
: q/a>li ( q/a -- li )
[ question>> "strong" build-tag* f "br" build-tag* 2array ] keep
answer>> append "li" build-tag* ;
: xml>q/a ( xml -- q/a )
[ "question" tag-named tag-children ] keep
"answer" tag-named tag-children <q/a> ;
[ "question" tag-named children>> ] keep
"answer" tag-named children>> <q/a> ;
: q/a>xml ( q/a -- xml )
[ question>> "question" build-tag* ] keep
@ -39,7 +39,7 @@ C: <question-list> question-list
: xml>question-list ( list -- question-list )
[ "title" swap at ] keep
tag-children [ tag? ] filter [ xml>q/a ] map
children>> [ tag? ] filter [ xml>q/a ] map
<question-list> ;
: question-list>xml ( question-list -- list )

View File

@ -176,7 +176,7 @@ CHLOE: a
[ link-attrs ]
[ "method" optional-attr "post" or =method ]
[ "action" required-attr resolve-base-path =action ]
[ tag-attrs non-chloe-attrs-only print-attrs ]
[ attrs>> non-chloe-attrs-only print-attrs ]
} cleave
form>
]
@ -196,13 +196,13 @@ STRING: button-tag-markup
;
: add-tag-attrs ( attrs tag -- )
tag-attrs swap update ;
attrs>> swap update ;
CHLOE: button
button-tag-markup string>xml delegate
{
[ [ tag-attrs chloe-attrs-only ] dip add-tag-attrs ]
[ [ tag-attrs non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
[ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
[ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
[ [ children>string 1array ] dip "button" tag-named set-tag-children ]
[ nip ]
} 2cleave process-chloe-tag ;

View File

@ -22,10 +22,10 @@ C: <chloe> chloe
DEFER: process-template
: chloe-attrs-only ( assoc -- assoc' )
[ drop name-url chloe-ns = ] assoc-filter ;
[ drop url>> chloe-ns = ] assoc-filter ;
: non-chloe-attrs-only ( assoc -- assoc' )
[ drop name-url chloe-ns = not ] assoc-filter ;
[ drop url>> chloe-ns = not ] assoc-filter ;
: chloe-tag? ( tag -- ? )
dup xml? [ body>> ] when
@ -148,10 +148,10 @@ CHLOE-TUPLE: code
process-template
] [
{
[ xml-prolog write-prolog ]
[ xml-before write-chunk ]
[ prolog>> write-prolog ]
[ before>> write-chunk ]
[ process-template ]
[ xml-after write-chunk ]
[ after>> write-chunk ]
} cleave
] if
] with-scope ;

View File

@ -10,7 +10,7 @@ IN: springies.ui
: draw-node ( node -- ) pos>> { -5 -5 } v+ dup { 10 10 } v+ gl-rect ;
: draw-spring ( spring -- )
[ spring-node-a pos>> ] [ spring-node-b pos>> ] bi gl-line ;
[ node-a>> pos>> ] [ node-b>> pos>> ] bi gl-line ;
: draw-nodes ( -- ) nodes> [ draw-node ] each ;

View File

@ -1,5 +1,6 @@
USING: kernel namespaces namespaces.lib math sequences vars mortar slot-accessors x ;
USING: kernel namespaces namespaces.lib math sequences vars mortar
accessors slot-accessors x ;
IN: x.widgets.wm.workspace
@ -23,9 +24,9 @@ dpy get $default-root <- children [ <- mapped? ] filter ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: switch-to-workspace ( n -- )
mapped-windows current-workspace> workspaces> nth set-workspace-windows
mapped-windows current-workspace> workspaces> nth (>>windows)
mapped-windows [ <- unmap drop ] each
dup workspaces> nth workspace-windows [ <- map drop ] each
dup workspaces> nth windows>> [ <- map drop ] each
current-workspace set* ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!