]> gitweb.factorcode.org Git - factor.git/commitdiff
Services fixes
authorslava <slava@factorcode.org>
Wed, 24 May 2006 23:34:30 +0000 (23:34 +0000)
committerslava <slava@factorcode.org>
Wed, 24 May 2006 23:34:30 +0000 (23:34 +0000)
Factor.app/Contents/Info.plist
library/cocoa/callback.factor
library/cocoa/core-foundation.factor
library/cocoa/menu-bar.factor
library/cocoa/pasteboard-utils.factor
library/cocoa/services.factor
library/cocoa/ui.factor
library/compiler/alien/alien-invoke.factor

index 66f582d924503d3fa5d1f851f73ad3f98b92c0b2..686c996b1f0eb9f0e0537ecf1e2e1311f14d375c 100644 (file)
                        </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>
index 009c4d001e737c21961b2d13acd1f541840d8c67..7cbcbccab0728b4affe8e409ebe35e03ade4a89c 100644 (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
 
index c55d681ba489cf45d11d1514ae6973580b3376d8..4cfa1f7315fc553ba35795454f75a927854e789a 100644 (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 ) ;
 
index 7a387f71a61b86ab8fc97a3625bf395e88a0152f..e35086efb64331f8c3957c5fbe1b1d13cbfc657e 100644 (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
 
 ! -------------------------------------------------------------------------
 
index 1c3f35a995714bcbc1475740817c6cf384824698..2660a88b3a1280efe557f67746ed47c3e037f129 100644 (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 ;
index b9acc421132a5690369197de4c0f5af659496398..f47c38826434a1f08b62a7526d8dd87266d41be4 100644 (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
 
index d7e9378cac1a8f5c2a0cf7679a744f40c0a580cf..845c14470e7f74f4e4834c5fdba43102d4982cbc 100644 (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
index a4bae0d94b9c935ab5c0651624fcc13e42755850..bc616f1990ddfacd3ceb930b2ad1bc6100a4a4a9 100644 (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 ;