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

Services fixes

slava 2006-05-24 23:34:30 +00:00
parent e596ce53bb
commit 20306c972f
8 changed files with 86 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Factor.app/Contents/Info.plist
View File

@ -29,5 +29,42 @@
</array>
</dict>
</array>
<key>NSServices</key>
<array>
<dict>
<key>NSMenuItem</key>
<dict>
<key>default</key>
<string>Factor/Evaluate in Listener</string>
</dict>
<key>NSMessage</key>
<string>evalInListener</string>
<key>NSPortName</key>
<string>Factor</string>
<key>NSSendTypes</key>
<array>
<string>NSStringPboardType</string>
</array>
</dict>
<dict>
<key>NSMenuItem</key>
<dict>
<key>default</key>
<string>Factor/Evaluate Selection</string>
</dict>
<key>NSMessage</key>
<string>evalToString</string>
<key>NSPortName</key>
<string>Factor</string>
<key>NSSendTypes</key>
<array>
<string>NSStringPboardType</string>
</array>
<key>NSReturnTypes</key>
<array>
<string>NSStringPboardType</string>
</array>
</dict>
</array>
</dict>
</plist>

2
library/cocoa/callback.factor
View File

@ -1,3 +1,5 @@
! Copyright (C) 2005, 2006 Kevin Reid.
! See http://factorcode.org/license.txt for BSD license.
IN: objc-FactorCallback
DEFER: FactorCallback

4
library/cocoa/core-foundation.factor
View File

@ -6,11 +6,11 @@ namespaces sequences ;
TYPEDEF: int CFIndex
FUNCTION void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
FUNCTION: void* CFArrayCreateMutable ( void* allocator, CFIndex capacity, void* callbacks ) ;
FUNCTION: void* CFArrayGetValueAtIndex ( void* array, CFIndex idx ) ;
FUNCTION: void* CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
FUNCTION: void CFArraySetValueAtIndex ( void* array, CFIndex index, void* value ) ;
FUNCTION: CFIndex CFArrayGetCount ( void* array ) ;

2
library/cocoa/menu-bar.factor
View File

@ -5,7 +5,7 @@ gadgets-layouts gadgets-listener kernel memory objc
objc-FactorCallback objc-NSApplication objc-NSMenu
objc-NSMenuItem objc-NSObject objc-NSWindow sequences strings
words ;
IN: gadgets-cocoa
IN: cocoa
! -------------------------------------------------------------------------

19
library/cocoa/pasteboard-utils.factor
View File

@ -1,16 +1,21 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: cocoa
USING: kernel sequences objc-NSPasteboard ;
USING: arrays kernel objc-NSPasteboard sequences ;
: NSStringPboardType "NSStringPboardType" <NSString> ;
: NSStringPboardType "NSStringPboardType" ;
: pasteboard-type? ( type id -- seq )
NSStringPboardType swap [types] CF>array member? ;
: pasteboard-string? ( type id -- seq )
NSStringPboardType swap [types] CF>string-array member? ;
: pasteboard-string ( id -- str )
NSStringPboardType [stringForType:] dup [ CF>string ] when ;
NSStringPboardType <NSString> [stringForType:]
dup [ CF>string ] when ;
: set-pasteboard-types ( seq id -- )
swap <NSArray> f [declareTypes:owner:] ;
swap <NSArray> f [declareTypes:owner:] drop ;
: set-pasteboard-string ( str id -- )
swap <NSString> NSStringPboardType [setString:forType:] ;
NSStringPboardType <NSString>
dup 1array pick set-pasteboard-types
>r swap <NSString> r> [setString:forType:] drop ;

26
library/cocoa/services.factor
View File

@ -2,31 +2,35 @@ IN: objc-FactorServiceProvider
DEFER: FactorServiceProvider
IN: cocoa
USING: alien gadgets-presentations kernel objc
objc-NSApplication objc-NSObject parser styles ;
USING: alien gadgets-presentations io kernel namespaces objc
objc-NSApplication objc-NSObject parser prettyprint styles ;
: pasteboard-error ( error str -- f )
"Pasteboard does not hold a string" <NSString>
0 rot set-void*-nth f ;
0 swap rot set-void*-nth f ;
: ?pasteboard-string ( pboard error -- str/f )
NSStringPboardType pick pasteboard-type? [
over pasteboard-string? [
swap pasteboard-string [ ] [ pasteboard-error ] ?if
] [
nip pasteboard-error
] if ;
: do-service ( pboard error quot -- | quot: str -- str/f )
[
>r ?pasteboard-string dup [ r> call ] [ r> 2drop ] if
] keep over [ set-pasteboard-string ] [ 2drop ] if ;
pick >r >r
?pasteboard-string dup [ r> call ] [ r> 2drop f ] if
dup [ r> set-pasteboard-string ] [ r> 2drop ] if ;
"NSObject" "FactorServiceProvider" {
{ "evalInListener:" "void" { "id" "SEL" "id" "id" "void*" }
[ nip [ <input> f show-object f ] do-service ]
{
"evalInListener:userData:error:" "void"
{ "id" "SEL" "id" "id" "void*" }
[ nip [ <input> f show-object f ] do-service 2drop ]
}
{ "evalToString:" "void" { "id" "SEL" "id" "id" "void*" }
[ nip [ eval>string ] do-service ]
{
"evalToString:userData:error:" "void"
{ "id" "SEL" "id" "id" "void*" }
[ nip [ eval>string ] do-service 2drop ]
}
} { } define-objc-class

18
library/cocoa/ui.factor
View File

@ -5,7 +5,7 @@ IN: objc-FactorApplicationDelegate
DEFER: FactorApplicationDelegate
IN: cocoa
USING: gadgets-listener kernel objc objc-NSApplication
USING: gadgets gadgets-listener kernel objc objc-NSApplication
objc-NSObject ;
: finder-run-files ( alien -- )
@ -24,8 +24,16 @@ objc-NSObject ;
NSApp
FactorApplicationDelegate [alloc] [init] [setDelegate:] ;
: init-cocoa-ui ( -- )
reset-views
reset-callbacks
init-ui
install-app-delegate
register-services
default-main-menu ;
IN: gadgets
USING: errors freetype gadgets-cocoa objc-NSOpenGLContext
USING: errors freetype objc-NSOpenGLContext
objc-NSOpenGLView objc-NSView objc-NSWindow ;
: redraw-world ( handle -- )
@ -50,11 +58,7 @@ IN: shells
] unless
[
[
install-app-delegate
reset-views
reset-callbacks
init-ui
default-main-menu
init-cocoa-ui
listener-window
finish-launching
event-loop

13
library/compiler/alien/alien-invoke.factor
View File

@ -79,7 +79,7 @@ M: alien-invoke stack-reserve*
effect>string ;
: (define-c-word) ( type lib func types stack-effect -- )
>r over create-in >r
>r over create-in dup reset-generic >r
[ alien-invoke ] curry curry curry curry
r> swap define-compound word r>
"stack-effect" set-word-prop ;
@ -89,11 +89,10 @@ M: alien-invoke stack-reserve*
(define-c-word) ;
M: compound unxref-word*
dup word-def \ alien-invoke swap member?
over "infer" word-prop or [
drop
] [
dup "infer" word-prop [
dup
{ "infer-effect" "base-case" "no-effect" "terminates" }
reset-props update-xt
] if ;
reset-props
dup word-def \ alien-invoke swap member?
[ dup update-xt ] unless
] unless drop ;