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>
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 ;
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 ;
! 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 )
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
! 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
: (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
: 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
: 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 )
[ 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>
]
;
: 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 ;
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
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 ;
: 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 ;
-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
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: 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* ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!