Cocoa cleanup, AppleEvent handling, services

slava 2006-05-24 22:40:54 +00:00
parent f7210644a3
commit 703b6f58dd
15 changed files with 362 additions and 226 deletions

View File

@ -12,5 +12,22 @@
<string>Factor</string>
<key>CFBundlePackageType</key>
<string>APPL</string>
<key>CFBundleDocumentTypes</key>
<array>
<dict>
<key>CFBundleTypeExtensions</key>
<array>
<string>*</string>
</array>
<key>CFBundleTypeName</key>
<string>Any</string>
<key>CFBundleTypeRole</key>
<string>Viewer</string>
<key>CFBundleTypeOSTypes</key>
<array>
<string>****</string>
</array>
</dict>
</array>
</dict>
</plist>

View File

@ -1,7 +1,24 @@
- fix compiled gc check
+ refactor style stack code so that nested styles are handled at a lower-level
- in HTML, we can nest div tags, etc
- fix prettyprinter's highlighting of non-leaves looks bad
- maybe even go from markup to HTML?
- fix remaining HTML stream issues
- need to present $list in a useful way
- better line spacing in ui and html - related issue
+ tabular formatting in UI
- inspector
- how does this interact with outliner?
- $values
- other help aspects
- grid layout
+ fix compiled gc check
- there was a performance hit, investigate
- float boxing and overflow checks need a gc check too
- code walker & exceptions -- test and debug problems
- code walker and callbacks is broken?
- prettyprinter's highlighting of non-leaves looks bad
- look at xref issue
+ io:
@ -19,18 +36,20 @@
- method ordering and interpreter algorithm sections need updates
- document that can <void*> only be called with an alien
- help search
- fix remaining HTML stream issues
- automatically update help graph when adding/removing articles/words
- document conventions
- new turtle graphics tutorial
- better line spacing in ui and html
- tabular formatting - for inspector, changes and $values in help
- grid layout
- make the help look better, something like this:
http://twb.ath.cx/~twb/darcs/OBSOLETE/factor/final.html
+ ui/help:
- new leaner help viewer
- new inspector style:
- clicking objects sends them to the listener
- right click sends to listener & pushes on the stack
- debugger:
- continuation viewer tool, reuse old inspector code
- show a clickable menu of restarts...
- reuse windows where possible
- new browser:
- browse generic words and classes
- need actions for reloading the source file and opening word in jEdit

View File

@ -6,6 +6,10 @@ objc-NSApplication objc-NSAutoreleasePool objc-NSException
objc-NSNotificationCenter objc-NSObject objc-NSView sequences
threads ;
: NSApplicationDelegateReplySuccess 0 ;
: NSApplicationDelegateReplyCancel 1 ;
: NSApplicationDelegateReplyFailure 2 ;
: with-autorelease-pool ( quot -- )
NSAutoreleasePool [new] slip [release] ; inline
@ -14,7 +18,9 @@ threads ;
: with-cocoa ( quot -- )
[ NSApp drop call ] with-autorelease-pool ;
: <NSString> <CFString> [autorelease] ;
: <NSString> ( str -- alien ) <CFString> [autorelease] ;
: <NSArray> ( seq -- alien ) <CFArray> [autorelease] ;
: CFRunLoopDefaultMode "kCFRunLoopDefaultMode" <NSString> ;

View File

@ -6,14 +6,14 @@ namespaces sequences ;
TYPEDEF: int CFIndex
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: CFIndex CFArrayGetCount ( void* array ) ;
: CF>array ( alien -- array )
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
! Core Foundation utilities -- will be moved elsewhere
: kCFURLPOSIXPathStyle 0 ;
FUNCTION: void* CFURLCreateWithFileSystemPath ( void* allocator, void* filePath, int pathStyle, bool isDirectory ) ;
@ -36,6 +36,14 @@ FUNCTION: bool CFBundleLoadExecutable ( void* bundle ) ;
FUNCTION: void CFRelease ( void* cf ) ;
: CF>array ( alien -- array )
dup CFArrayGetCount [ CFArrayGetValueAtIndex ] map-with ;
: <CFArray> ( seq -- array )
[ f swap length f CFArrayCreateMutable ] keep
[ length ] keep
[ >r dupd r> CFArraySetValueAtIndex ] 2each ;
: <CFString> ( string -- cf )
f swap dup length CFStringCreateWithCharacters ;
@ -44,6 +52,9 @@ FUNCTION: void CFRelease ( void* cf ) ;
>r 0 over CFStringGetLength r> CFStringGetCharacters
] keep alien>u16-string ;
: CF>string-array ( alien -- seq )
CF>array [ CF>string ] map ;
: <CFFileSystemURL> ( string dir? -- cf )
>r <CFString> f over kCFURLPOSIXPathStyle
r> CFURLCreateWithFileSystemPath swap CFRelease ;

View File

@ -16,4 +16,4 @@ sequences ;
: open-panel ( -- paths )
<NSOpenPanel> dup f [runModalForTypes:] NSOKButton =
[ [filenames] CF>array [ CF>string ] map ] [ drop f ] if ;
[ [filenames] CF>string-array ] [ drop f ] if ;

View File

@ -20,6 +20,7 @@ USING: cocoa compiler io kernel objc sequences words ;
"NSOpenGLContext"
"NSOpenGLView"
"NSOpenPanel"
"NSPasteboard"
"NSSavePanel"
"NSView"
"NSWindow"

View File

@ -9,10 +9,12 @@ USING: compiler io parser sequences words ;
"/library/cocoa/init-cocoa.factor"
"/library/cocoa/callback.factor"
"/library/cocoa/application-utils.factor"
"/library/cocoa/window-utils.factor"
"/library/cocoa/view-utils.factor"
"/library/cocoa/window-utils.factor"
"/library/cocoa/dialogs.factor"
"/library/cocoa/menu-bar.factor"
"/library/cocoa/pasteboard-utils.factor"
"/library/cocoa/services.factor"
"/library/cocoa/ui.factor"
} [
run-resource

View File

@ -33,18 +33,22 @@ M: quotation to-target-and-action
[initWithTitle:action:keyEquivalent:] [autorelease] ;
: make-menu-item ( title spec -- item )
to-target-and-action >r swap <NSMenuItem> dup r> [setTarget:] ;
to-target-and-action >r swap <NSMenuItem> dup
r> [setTarget:] ;
: submenu-to-item ( menu -- item )
dup [title] CF>string f "" <NSMenuItem> dup rot [setSubmenu:] ;
dup [title] CF>string f "" <NSMenuItem> dup
rot [setSubmenu:] ;
: add-submenu ( menu submenu -- )
submenu-to-item [addItem:] ;
: and-modifiers ( item key-equivalent-modifier-mask -- item )
dupd [setKeyEquivalentModifierMask:] ;
: and-alternate ( item -- item )
dup 1 [setAlternate:] ;
: and-option-equivalent-modifier 1572864 and-modifiers ;
! -------------------------------------------------------------------------
@ -130,7 +134,6 @@ DEFER: described-menu
{ "Paste and Match Style" "pasteAsPlainText:" "V" [ and-option-equivalent-modifier ] }
{ "Delete" "delete:" "" }
{ "Select All" "selectAll:" "a" }
! { }
! Find, Spelling, and Speech submenus go here
} }
{ {

View File

@ -0,0 +1,16 @@
IN: cocoa
USING: kernel sequences objc-NSPasteboard ;
: NSStringPboardType "NSStringPboardType" <NSString> ;
: pasteboard-type? ( type id -- seq )
NSStringPboardType swap [types] CF>array member? ;
: pasteboard-string ( id -- str )
NSStringPboardType [stringForType:] dup [ CF>string ] when ;
: set-pasteboard-types ( seq id -- )
swap <NSArray> f [declareTypes:owner:] ;
: set-pasteboard-string ( str id -- )
swap <NSString> NSStringPboardType [setString:forType:] ;

View File

@ -0,0 +1,36 @@
IN: objc-FactorServiceProvider
DEFER: FactorServiceProvider
IN: cocoa
USING: alien gadgets-presentations kernel objc
objc-NSApplication objc-NSObject parser styles ;
: pasteboard-error ( error str -- f )
"Pasteboard does not hold a string" <NSString>
0 rot set-void*-nth f ;
: ?pasteboard-string ( pboard error -- str/f )
NSStringPboardType pick pasteboard-type? [
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 ;
"NSObject" "FactorServiceProvider" {
{ "evalInListener:" "void" { "id" "SEL" "id" "id" "void*" }
[ nip [ <input> f show-object f ] do-service ]
}
{ "evalToString:" "void" { "id" "SEL" "id" "id" "void*" }
[ nip [ eval>string ] do-service ]
}
} { } define-objc-class
: register-services ( -- )
NSApp
FactorServiceProvider [alloc] [init]
[setServicesProvider:] ;

View File

@ -1,216 +1,32 @@
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: objc-FactorView
DEFER: FactorView
IN: objc-FactorUIWindowDelegate
DEFER: FactorUIWindowDelegate
IN: objc-FactorApplicationDelegate
USING: alien arrays cocoa errors freetype gadgets
gadgets-launchpad gadgets-layouts gadgets-listener gadgets-panes
hashtables kernel math namespaces objc objc-NSApplication
objc-NSEvent objc-NSObject objc-NSOpenGLContext
objc-NSOpenGLView objc-NSView objc-NSWindow sequences threads ;
DEFER: FactorApplicationDelegate
! Cocoa backend for Factor UI
IN: cocoa
USING: gadgets-listener kernel objc objc-NSApplication
objc-NSObject ;
IN: gadgets-cocoa
: finder-run-files ( alien -- )
CF>string-array listener-run-files
NSApp NSApplicationDelegateReplySuccess
[replyToOpenOrPrint:] ;
! Hash mapping aliens to gadgets
SYMBOL: views
: reset-views ( hash -- hash ) H{ } clone views set-global ;
reset-views
: view ( handle -- world ) views get hash ;
: mouse-location ( view event -- loc )
over >r
[locationInWindow] f [convertPoint:fromView:]
dup NSPoint-x swap NSPoint-y
r> [frame] NSRect-h swap - 0 3array ;
: send-mouse-moved ( view event -- )
over >r mouse-location r> view move-hand ;
: button ( event -- n )
#! Cocoa -> Factor UI button mapping
[buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
: button&loc ( view event -- button# loc )
dup button -rot mouse-location ;
: modifiers
{
{ S+ HEX: 10000 }
{ C+ HEX: 40000 }
{ A+ HEX: 80000 }
{ M+ HEX: 100000 }
} ;
: key-codes
H{
{ 36 "RETURN" }
{ 48 "TAB" }
{ 51 "BACKSPACE" }
{ 115 "HOME" }
{ 117 "DELETE" }
{ 119 "END" }
{ 123 "LEFT" }
{ 124 "RIGHT" }
{ 125 "DOWN" }
{ 126 "UP" }
} ;
: key-code ( event -- string )
dup [keyCode] key-codes hash
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
: event>gesture ( event -- modifiers keycode )
dup [modifierFlags] modifiers modifier swap key-code ;
: send-key-event ( view event quot -- )
>r event>gesture r> call swap view world-focus
handle-gesture ; inline
: send-user-input ( view event -- )
[characters] CF>string swap view world-focus user-input ;
: send-key-down-event ( view event -- )
2dup [ <key-down> ] send-key-event
[ send-user-input ] [ 2drop ] if ;
: send-key-up-event ( view event -- )
[ <key-up> ] send-key-event ;
: send-button-down$ ( view event -- )
over >r button&loc r> view send-button-down ;
: send-button-up$ ( view event -- )
over >r button&loc r> view send-button-up ;
: send-wheel$ ( view event -- )
[ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
"NSOpenGLView" "FactorView" {
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop view draw-world ]
}
{ "mouseMoved:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "mouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "scrollWheel:" "void" { "id" "SEL" "id" }
[ nip send-wheel$ ]
}
{ "keyDown:" "void" { "id" "SEL" "id" }
[ nip send-key-down-event ]
}
{ "keyUp:" "void" { "id" "SEL" "id" }
[ nip send-key-up-event ]
}
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
[ 2drop dup view-dim swap view set-gadget-dim ]
}
{ "acceptsFirstResponder" "bool" { "id" "SEL" }
[ 2drop 1 ]
}
{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
[
rot drop
SUPER-> [initWithFrame:pixelFormat:]
dup "updateFactorGadgetSize:" add-resize-observer
]
}
{ "dealloc" "void" { "id" "SEL" }
[
drop
dup view close-world
dup views get remove-hash
dup remove-observer
SUPER-> [dealloc]
]
! Handle Open events from the Finder
"NSObject" "FactorApplicationDelegate" {
{ "application:openFiles:" "void" { "id" "SEL" "id" "id" }
[ >r 3drop r> finder-run-files ]
}
} { } define-objc-class
: register-view ( world -- )
dup world-handle views get set-hash ;
: <FactorView> ( gadget -- view )
FactorView over rect-dim <GLView>
[ over set-world-handle dup add-notify register-view ] keep ;
: window-root-gadget-pref-dim [contentView] view pref-dim ;
: frame-rect-for-window-content-rect ( window rect -- rect )
swap [styleMask] NSWindow -rot [frameRectForContentRect:styleMask:] ;
: content-rect-for-window-frame-rect ( window rect -- rect )
swap [styleMask] NSWindow -rot [contentRectForFrameRect:styleMask:] ;
: window-content-rect ( window -- rect )
dup [frame] content-rect-for-window-frame-rect ;
"NSObject" "FactorUIWindowDelegate" {
{ "windowWillUseStandardFrame:defaultFrame:" "NSRect" { "id" "SEL" "id" "NSRect" }
[
drop 2nip
dup window-content-rect NSRect-x-far-y
pick window-root-gadget-pref-dim first2
<far-y-NSRect>
frame-rect-for-window-content-rect
]
}
} { } define-objc-class
: install-window-delegate ( window -- )
FactorUIWindowDelegate [alloc] [init] [setDelegate:] ;
: install-app-delegate ( -- )
NSApp
FactorApplicationDelegate [alloc] [init] [setDelegate:] ;
IN: gadgets
USING: errors freetype gadgets-cocoa objc-NSOpenGLContext
objc-NSOpenGLView objc-NSView objc-NSWindow ;
: redraw-world ( handle -- )
world-handle 1 [setNeedsDisplay:] ;
@ -234,6 +50,7 @@ IN: shells
] unless
[
[
install-app-delegate
reset-views
reset-callbacks
init-ui

View File

@ -1,8 +1,13 @@
! Copyright (C) 2006 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
IN: objc-FactorView
DEFER: FactorView
IN: cocoa
USING: arrays kernel objc-NSObject objc-NSOpenGLContext
objc-NSOpenGLView objc-NSView opengl sequences ;
USING: arrays gadgets gadgets-layouts hashtables kernel math
namespaces objc objc-NSEvent objc-NSObject
objc-NSOpenGLContext objc-NSOpenGLView objc-NSView opengl
sequences ;
: <GLView> ( class dim -- view )
>r [alloc] 0 0 r> first2 <NSRect>
@ -18,3 +23,172 @@ objc-NSOpenGLView objc-NSView opengl sequences ;
: add-resize-observer ( view selector -- )
NSViewFrameDidChangeNotification pick add-observer ;
! Hash mapping aliens to gadgets
SYMBOL: views
: reset-views ( hash -- hash ) H{ } clone views set-global ;
reset-views
: view ( handle -- world ) views get hash ;
: mouse-location ( view event -- loc )
over >r
[locationInWindow] f [convertPoint:fromView:]
dup NSPoint-x swap NSPoint-y
r> [frame] NSRect-h swap - 0 3array ;
: send-mouse-moved ( view event -- )
over >r mouse-location r> view move-hand ;
: button ( event -- n )
#! Cocoa -> Factor UI button mapping
[buttonNumber] H{ { 0 1 } { 2 2 } { 1 3 } } hash ;
: button&loc ( view event -- button# loc )
dup button -rot mouse-location ;
: modifiers
{
{ S+ HEX: 10000 }
{ C+ HEX: 40000 }
{ A+ HEX: 80000 }
{ M+ HEX: 100000 }
} ;
: key-codes
H{
{ 36 "RETURN" }
{ 48 "TAB" }
{ 51 "BACKSPACE" }
{ 115 "HOME" }
{ 117 "DELETE" }
{ 119 "END" }
{ 123 "LEFT" }
{ 124 "RIGHT" }
{ 125 "DOWN" }
{ 126 "UP" }
} ;
: key-code ( event -- string )
dup [keyCode] key-codes hash
[ ] [ [charactersIgnoringModifiers] CF>string ] ?if ;
: event>gesture ( event -- modifiers keycode )
dup [modifierFlags] modifiers modifier swap key-code ;
: send-key-event ( view event quot -- )
>r event>gesture r> call swap view world-focus
handle-gesture ; inline
: send-user-input ( view event -- )
[characters] CF>string swap view world-focus user-input ;
: send-key-down-event ( view event -- )
2dup [ <key-down> ] send-key-event
[ send-user-input ] [ 2drop ] if ;
: send-key-up-event ( view event -- )
[ <key-up> ] send-key-event ;
: send-button-down$ ( view event -- )
over >r button&loc r> view send-button-down ;
: send-button-up$ ( view event -- )
over >r button&loc r> view send-button-up ;
: send-wheel$ ( view event -- )
[ [deltaY] 0 > ] 2keep mouse-location rot view send-wheel ;
"NSOpenGLView" "FactorView" {
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
[ 2drop view draw-world ]
}
{ "mouseMoved:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "rightMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "otherMouseDragged:" "void" { "id" "SEL" "id" }
[ nip send-mouse-moved ]
}
{ "mouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "mouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "rightMouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "rightMouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "otherMouseDown:" "void" { "id" "SEL" "id" }
[ nip send-button-down$ ]
}
{ "otherMouseUp:" "void" { "id" "SEL" "id" }
[ nip send-button-up$ ]
}
{ "scrollWheel:" "void" { "id" "SEL" "id" }
[ nip send-wheel$ ]
}
{ "keyDown:" "void" { "id" "SEL" "id" }
[ nip send-key-down-event ]
}
{ "keyUp:" "void" { "id" "SEL" "id" }
[ nip send-key-up-event ]
}
{ "updateFactorGadgetSize:" "void" { "id" "SEL" "id" }
[ 2drop dup view-dim swap view set-gadget-dim ]
}
{ "acceptsFirstResponder" "bool" { "id" "SEL" }
[ 2drop 1 ]
}
{ "initWithFrame:pixelFormat:" "id" { "id" "SEL" "NSRect" "id" }
[
rot drop
SUPER-> [initWithFrame:pixelFormat:]
dup "updateFactorGadgetSize:" add-resize-observer
]
}
{ "dealloc" "void" { "id" "SEL" }
[
drop
dup view close-world
dup views get remove-hash
dup remove-observer
SUPER-> [dealloc]
]
}
} { } define-objc-class
: register-view ( world -- )
dup world-handle views get set-hash ;
: <FactorView> ( gadget -- view )
FactorView over rect-dim <GLView> [
over set-world-handle dup add-notify register-view
] keep ;

View File

@ -1,7 +1,11 @@
! Copyright (C) 2006 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
IN: objc-FactorWindowDelegate
DEFER: FactorWindowDelegate
IN: cocoa
USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
USING: gadgets-layouts kernel math objc objc-NSObject
objc-NSView objc-NSWindow sequences ;
: NSBorderlessWindowMask 0 ; inline
: NSTitledWindowMask 1 ; inline
@ -31,3 +35,33 @@ USING: kernel math objc-NSObject objc-NSView objc-NSWindow ;
dup dup [contentView] [setInitialFirstResponder:]
dup 1 [setAcceptsMouseMovedEvents:]
dup f [makeKeyAndOrderFront:] ;
: window-root-gadget-pref-dim [contentView] view pref-dim ;
: frame-rect-for-window-content-rect ( window rect -- rect )
swap [styleMask] NSWindow -rot
[frameRectForContentRect:styleMask:] ;
: content-rect-for-window-frame-rect ( window rect -- rect )
swap [styleMask] NSWindow -rot
[contentRectForFrameRect:styleMask:] ;
: window-content-rect ( window -- rect )
dup [frame] content-rect-for-window-frame-rect ;
"NSObject" "FactorWindowDelegate" {
{
"windowWillUseStandardFrame:defaultFrame:" "NSRect"
{ "id" "SEL" "id" "NSRect" }
[
drop 2nip
dup window-content-rect NSRect-x-far-y
pick window-root-gadget-pref-dim first2
<far-y-NSRect>
frame-rect-for-window-content-rect
]
}
} { } define-objc-class
: install-window-delegate ( window -- )
FactorWindowDelegate [alloc] [init] [setDelegate:] ;

View File

@ -32,6 +32,9 @@ words ;
: try-run-file ( file -- ) [ [ run-file ] keep ] try drop ;
: eval>string ( str -- str )
[ [ [ eval ] keep ] try drop ] string-out ;
: parse-resource ( path -- quot )
dup parsing-file
[ <resource-stream> "resource:" ] keep append parse-stream ;

View File

@ -55,9 +55,6 @@ parser prettyprint sequences strings words ;
: read-packet ( -- string ) 4 read be> read ;
: eval>string ( str -- )
[ [ [ eval ] keep ] try drop ] string-out ;
: wire-server ( -- )
#! Repeatedly read jEdit requests and execute them. Return
#! on EOF.