cocoa.subclassing: cleaner CLASS: syntax; ui.backend.cocoa: ignore events delivered after window closed to fix FEP (reported by Doug Coleman)
Slava Pestov
parent
bb4dae64f3
commit
425c572fa8
|
|
@ -4,14 +4,12 @@ tools.test memory compiler.units math core-graphics.types ;
|
|||
FROM: alien.c-types => int void ;
|
||||
IN: cocoa.tests
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "Foo" }
|
||||
}
|
||||
|
||||
CLASS: Foo < NSObject
|
||||
[
|
||||
METHOD: void foo: NSRect rect [
|
||||
gc rect "x" set
|
||||
] ;
|
||||
]
|
||||
]
|
||||
|
||||
: test-foo ( -- )
|
||||
Foo -> alloc -> init
|
||||
|
|
@ -25,12 +23,10 @@ test-foo
|
|||
[ 101.0 ] [ "x" get CGRect-w ] unit-test
|
||||
[ 102.0 ] [ "x" get CGRect-h ] unit-test
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "Bar" }
|
||||
}
|
||||
|
||||
METHOD: NSRect bar [ test-foo "x" get ] ;
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: NSRect bar [ test-foo "x" get ]
|
||||
]
|
||||
|
||||
Bar [
|
||||
-> alloc -> init
|
||||
|
|
@ -44,14 +40,12 @@ Bar [
|
|||
[ 102.0 ] [ "x" get CGRect-h ] unit-test
|
||||
|
||||
! Make sure that we can add methods
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "Bar" }
|
||||
}
|
||||
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: NSRect bar [ test-foo "x" get ]
|
||||
|
||||
METHOD: int babb: int x [ x sq ] ;
|
||||
METHOD: int babb: int x [ x sq ]
|
||||
]
|
||||
|
||||
[ 144 ] [
|
||||
Bar [
|
||||
|
|
|
|||
|
|
@ -1,41 +1,10 @@
|
|||
USING: help.markup help.syntax strings alien hashtables ;
|
||||
IN: cocoa.subclassing
|
||||
|
||||
HELP: define-objc-class
|
||||
{ $values { "imeth" "a sequence of instance method definitions" } { "hash" hashtable } }
|
||||
{ $description "Defines a new Objective C class. The hashtable can contain the following keys:"
|
||||
{ $list
|
||||
{ { $link +name+ } " - a string naming the new class. Required." }
|
||||
{ { $link +superclass+ } " - a string naming the superclass. Required." }
|
||||
{ { $link +protocols+ } " - an array of strings naming protocols implemented by the superclass. Optional." }
|
||||
}
|
||||
"Every element of " { $snippet "imeth" } " defines an instance method, and is an array having the shape "
|
||||
{ $snippet "{ name return args quot }" }
|
||||
".:"
|
||||
{ $table
|
||||
{ "name" { "a selector name" } }
|
||||
{ "name" { "a C type name; see " { $link "c-data" } } }
|
||||
{ "args" { "a sequence of C type names; see " { $link "c-data" } } }
|
||||
{ "quot" { "a quotation to be run as a callback when the method is invoked; see " { $link alien-callback } } }
|
||||
}
|
||||
"The quotation is run with the following values on the stack:"
|
||||
{ $list
|
||||
{ "the receiver of the message; an " { $link alien } " pointing to an instance of this class" }
|
||||
{ "the selector naming the message; in most cases this value can be ignored" }
|
||||
"arguments passed to the message, if any"
|
||||
}
|
||||
"There is no way to define instance variables or class methods using this mechanism. However, instance variables can be simulated by using the receiver to key into an assoc." } ;
|
||||
|
||||
HELP: CLASS:
|
||||
{ $syntax "CLASS: spec imeth... ;" }
|
||||
{ $values { "spec" "an array of pairs" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } }
|
||||
{ $description "Defines a new Objective C class. The hashtable can contain the following keys:"
|
||||
{ $list
|
||||
{ { $link +name+ } " - a string naming the new class. Required." }
|
||||
{ { $link +superclass+ } " - a string naming the superclass. Required." }
|
||||
{ { $link +protocols+ } " - an array of strings naming protocols implemented by the superclass. Optional." }
|
||||
}
|
||||
"Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word."
|
||||
{ $syntax "CLASS: name < superclass protocols... [ imeth... ]" }
|
||||
{ $values { "name" "a new class name" } { "superclass" "a superclass name" } { "protocols" "zero or more protocol names" } { "name" "a new class name" } { "imeth" "instance method definitions using " { $link POSTPONE: METHOD: } } }
|
||||
{ $description "Defines a new Objective C class. Instance methods are defined with the " { $link POSTPONE: METHOD: } " parsing word."
|
||||
$nl
|
||||
"This word is preferred to calling " { $link define-objc-class } ", because it creates a class word in the " { $vocab-link "cocoa.classes" } " vocabulary at parse time, allowing code to refer to the class word in the same source file where the class is defined." } ;
|
||||
|
||||
|
|
@ -49,8 +18,6 @@ HELP: METHOD:
|
|||
ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
|
||||
"Objective C classes can be subclassed, with new methods defined in Factor, using parsing words:"
|
||||
{ $subsections POSTPONE: CLASS: POSTPONE: METHOD: }
|
||||
"This word is actually syntax sugar for an ordinary word:"
|
||||
{ $subsections define-objc-class }
|
||||
"Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
|
||||
|
||||
IN: cocoa.subclassing
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ IN: cocoa.subclassing
|
|||
: add-protocols ( protocols class -- )
|
||||
'[ [ _ ] dip objc-protocol add-protocol ] each ;
|
||||
|
||||
: (define-objc-class) ( imeth protocols superclass name -- )
|
||||
: (define-objc-class) ( methods protocols superclass name -- )
|
||||
[ objc-class ] dip 0 objc_allocateClassPair
|
||||
[ add-protocols ] [ add-methods ] [ objc_registerClassPair ]
|
||||
tri ;
|
||||
|
|
@ -59,28 +59,23 @@ IN: cocoa.subclassing
|
|||
class sel imp types add-method
|
||||
] if* ;
|
||||
|
||||
: redefine-objc-methods ( imeth name -- )
|
||||
: redefine-objc-methods ( methods name -- )
|
||||
dup class-exists? [
|
||||
objc_getClass '[ [ _ ] dip (redefine-objc-method) ] each
|
||||
] [ 2drop ] if ;
|
||||
|
||||
SYMBOL: +name+
|
||||
SYMBOL: +protocols+
|
||||
SYMBOL: +superclass+
|
||||
|
||||
: define-objc-class ( imeth hash -- )
|
||||
clone [
|
||||
prepare-methods
|
||||
+name+ get "cocoa.classes" create drop
|
||||
+name+ get 2dup redefine-objc-methods swap
|
||||
+protocols+ get +superclass+ get +name+ get
|
||||
'[ _ _ _ _ (define-objc-class) ]
|
||||
import-objc-class
|
||||
] bind ;
|
||||
:: define-objc-class ( name superclass protocols methods -- )
|
||||
methods prepare-methods :> methods
|
||||
name "cocoa.classes" create drop
|
||||
methods name redefine-objc-methods
|
||||
name [ methods protocols superclass name (define-objc-class) ] import-objc-class ;
|
||||
|
||||
SYNTAX: CLASS:
|
||||
parse-definition unclip
|
||||
>hashtable define-objc-class ;
|
||||
scan-token
|
||||
"<" expect
|
||||
scan-token
|
||||
"[" parse-tokens
|
||||
\ ] parse-until define-objc-class ;
|
||||
|
||||
: (parse-selector) ( -- )
|
||||
scan-token {
|
||||
|
|
|
|||
|
|
@ -6,16 +6,14 @@ kernel math ;
|
|||
FROM: alien.c-types => float ;
|
||||
IN: tools.deploy.test.14
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "Bar" }
|
||||
}
|
||||
|
||||
CLASS: Bar < NSObject
|
||||
[
|
||||
METHOD: float bar: NSRect rect [
|
||||
rect origin>> [ x>> ] [ y>> ] bi +
|
||||
rect size>> [ w>> ] [ h>> ] bi +
|
||||
+
|
||||
] ;
|
||||
]
|
||||
]
|
||||
|
||||
: main ( -- )
|
||||
Bar -> alloc -> init
|
||||
|
|
|
|||
|
|
@ -228,12 +228,11 @@ M: cocoa-ui-backend system-alert
|
|||
] [ 2drop ] if*
|
||||
init-thread-timer ;
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "FactorApplicationDelegate" }
|
||||
}
|
||||
|
||||
METHOD: void applicationDidUpdate: id obj [ reset-run-loop ] ;
|
||||
CLASS: FactorApplicationDelegate < NSObject
|
||||
[
|
||||
METHOD: void applicationDidUpdate: id obj
|
||||
[ reset-run-loop ]
|
||||
]
|
||||
|
||||
: install-app-delegate ( -- )
|
||||
NSApp FactorApplicationDelegate install-delegate ;
|
||||
|
|
|
|||
|
|
@ -21,11 +21,8 @@ IN: ui.backend.cocoa.tools
|
|||
image save-panel [ save-image ] when* ;
|
||||
|
||||
! Handle Open events from the Finder
|
||||
CLASS: {
|
||||
{ +superclass+ "FactorApplicationDelegate" }
|
||||
{ +name+ "FactorWorkspaceApplicationDelegate" }
|
||||
}
|
||||
|
||||
CLASS: FactorWorkspaceApplicationDelegate < FactorApplicationDelegate
|
||||
[
|
||||
METHOD: void application: id app openFiles: id files [ files finder-run-files ]
|
||||
|
||||
METHOD: int applicationShouldHandleReopen: id app hasVisibleWindows: int flag [ flag 0 = [ show-listener ] when 1 ]
|
||||
|
|
@ -44,7 +41,8 @@ METHOD: id saveFactorImage: id app [ save f ]
|
|||
|
||||
METHOD: id saveFactorImageAs: id app [ menu-save-image f ]
|
||||
|
||||
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ] ;
|
||||
METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ]
|
||||
]
|
||||
|
||||
: install-app-delegate ( -- )
|
||||
NSApp FactorWorkspaceApplicationDelegate install-delegate ;
|
||||
|
|
@ -55,11 +53,8 @@ METHOD: id refreshAll: id app [ [ refresh-all ] \ refresh-all call-listener f ]
|
|||
dup [ quot call( string -- result/f ) ] when
|
||||
[ pboard set-pasteboard-string ] when* ;
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSObject" }
|
||||
{ +name+ "FactorServiceProvider" }
|
||||
}
|
||||
|
||||
CLASS: FactorServiceProvider < NSObject
|
||||
[
|
||||
METHOD: void evalInListener: id pboard userData: id userData error: id error
|
||||
[ pboard error [ eval-listener f ] do-service ]
|
||||
|
||||
|
|
@ -67,7 +62,8 @@ METHOD: void evalToString: id pboard userData: id userData error: id error
|
|||
[
|
||||
pboard error
|
||||
[ [ (eval>string) ] with-interactive-vocabs ] do-service
|
||||
] ;
|
||||
]
|
||||
]
|
||||
|
||||
: register-services ( -- )
|
||||
NSApp
|
||||
|
|
|
|||
|
|
@ -3,14 +3,16 @@
|
|||
USING: accessors alien alien.c-types alien.data alien.strings
|
||||
arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
|
||||
cocoa.classes cocoa.views cocoa.application cocoa.pasteboard
|
||||
cocoa.runtime cocoa.types cocoa.windows sequences io.encodings.utf8
|
||||
ui ui.private ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
|
||||
core-foundation.strings core-graphics core-graphics.types threads
|
||||
combinators math.rectangles ;
|
||||
cocoa.runtime cocoa.types cocoa.windows sequences
|
||||
io.encodings.utf8 locals ui ui.private ui.gadgets
|
||||
ui.gadgets.private ui.gadgets.worlds ui.gestures
|
||||
core-foundation.strings core-graphics core-graphics.types
|
||||
threads combinators math.rectangles ;
|
||||
IN: ui.backend.cocoa.views
|
||||
|
||||
: send-mouse-moved ( view event -- )
|
||||
[ mouse-location ] [ drop window ] 2bi move-hand fire-motion yield ;
|
||||
[ mouse-location ] [ drop window ] 2bi
|
||||
dup [ move-hand fire-motion yield ] [ 2drop ] if ;
|
||||
|
||||
: button ( event -- n )
|
||||
#! Cocoa -> Factor UI button mapping
|
||||
|
|
@ -62,7 +64,7 @@ CONSTANT: key-codes
|
|||
[ event-modifiers ] [ key-code ] bi ;
|
||||
|
||||
: send-key-event ( view gesture -- )
|
||||
swap window propagate-key-gesture ;
|
||||
swap window dup [ propagate-key-gesture ] [ 2drop ] if ;
|
||||
|
||||
: interpret-key-event ( view event -- )
|
||||
NSArray swap -> arrayWithObject: -> interpretKeyEvents: ;
|
||||
|
|
@ -82,22 +84,25 @@ CONSTANT: key-codes
|
|||
[ nip mouse-event>gesture <button-down> ]
|
||||
[ mouse-location ]
|
||||
[ drop window ]
|
||||
2tri send-button-down ;
|
||||
2tri
|
||||
dup [ send-button-down ] [ 3drop ] if ;
|
||||
|
||||
: send-button-up$ ( view event -- )
|
||||
[ nip mouse-event>gesture <button-up> ]
|
||||
[ mouse-location ]
|
||||
[ drop window ]
|
||||
2tri send-button-up ;
|
||||
2tri
|
||||
dup [ send-button-up ] [ 3drop ] if ;
|
||||
|
||||
: send-scroll$ ( view event -- )
|
||||
[ nip [ -> deltaX ] [ -> deltaY ] bi [ neg ] bi@ 2array ]
|
||||
[ mouse-location ]
|
||||
[ drop window ]
|
||||
2tri send-scroll ;
|
||||
2tri
|
||||
dup [ send-scroll ] [ 3drop ] if ;
|
||||
|
||||
: send-action$ ( view event gesture -- junk )
|
||||
[ drop window ] dip send-action f ;
|
||||
: send-action$ ( view event gesture -- )
|
||||
[ drop window ] dip over [ send-action ] [ 2drop ] if ;
|
||||
|
||||
: add-resize-observer ( observer object -- )
|
||||
[
|
||||
|
|
@ -141,14 +146,10 @@ CONSTANT: selector>action H{
|
|||
selector>action at
|
||||
[ swap world-focus parents-handle-gesture? t ] [ drop f f ] if* ;
|
||||
|
||||
CLASS: {
|
||||
{ +superclass+ "NSOpenGLView" }
|
||||
{ +name+ "FactorView" }
|
||||
{ +protocols+ { "NSTextInput" } }
|
||||
}
|
||||
|
||||
CLASS: FactorView < NSOpenGLView NSTextInput
|
||||
[
|
||||
! Rendering
|
||||
METHOD: void drawRect: NSRect rect [ self window draw-world ]
|
||||
METHOD: void drawRect: NSRect rect [ self window [ draw-world ] when* ]
|
||||
|
||||
! Events
|
||||
METHOD: char acceptsFirstMouse: id event [ 1 ]
|
||||
|
|
@ -185,42 +186,43 @@ METHOD: void keyUp: id event [ self event send-key-up-event ]
|
|||
|
||||
METHOD: char validateUserInterfaceItem: id event
|
||||
[
|
||||
self window
|
||||
self window [
|
||||
event -> action utf8 alien>string validate-action
|
||||
[ >c-bool ] [ drop self event SUPER-> validateUserInterfaceItem: ] if
|
||||
] [ 0 ] if*
|
||||
]
|
||||
|
||||
METHOD: id undo: id event [ self event undo-action send-action$ ]
|
||||
METHOD: id undo: id event [ self event undo-action send-action$ f ]
|
||||
|
||||
METHOD: id redo: id event [ self event redo-action send-action$ ]
|
||||
METHOD: id redo: id event [ self event redo-action send-action$ f ]
|
||||
|
||||
METHOD: id cut: id event [ self event cut-action send-action$ ]
|
||||
METHOD: id cut: id event [ self event cut-action send-action$ f ]
|
||||
|
||||
METHOD: id copy: id event [ self event copy-action send-action$ ]
|
||||
METHOD: id copy: id event [ self event copy-action send-action$ f ]
|
||||
|
||||
METHOD: id paste: id event [ self event paste-action send-action$ ]
|
||||
METHOD: id paste: id event [ self event paste-action send-action$ f ]
|
||||
|
||||
METHOD: id delete: id event [ self event delete-action send-action$ ]
|
||||
METHOD: id delete: id event [ self event delete-action send-action$ f ]
|
||||
|
||||
METHOD: id selectAll: id event [ self event select-all-action send-action$ ]
|
||||
METHOD: id selectAll: id event [ self event select-all-action send-action$ f ]
|
||||
|
||||
METHOD: id newDocument: id event [ self event new-action send-action$ ]
|
||||
METHOD: id newDocument: id event [ self event new-action send-action$ f ]
|
||||
|
||||
METHOD: id openDocument: id event [ self event open-action send-action$ ]
|
||||
METHOD: id openDocument: id event [ self event open-action send-action$ f ]
|
||||
|
||||
METHOD: id saveDocument: id event [ self event save-action send-action$ ]
|
||||
METHOD: id saveDocument: id event [ self event save-action send-action$ f ]
|
||||
|
||||
METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ ]
|
||||
METHOD: id saveDocumentAs: id event [ self event save-as-action send-action$ f ]
|
||||
|
||||
METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ ]
|
||||
METHOD: id revertDocumentToSaved: id event [ self event revert-action send-action$ f ]
|
||||
|
||||
! Multi-touch gestures
|
||||
METHOD: void magnifyWithEvent: id event
|
||||
[
|
||||
self event
|
||||
dup -> deltaZ sgn {
|
||||
{ 1 [ zoom-in-action send-action$ drop ] }
|
||||
{ -1 [ zoom-out-action send-action$ drop ] }
|
||||
{ 1 [ zoom-in-action send-action$ ] }
|
||||
{ -1 [ zoom-out-action send-action$ ] }
|
||||
{ 0 [ 2drop ] }
|
||||
} case
|
||||
]
|
||||
|
|
@ -229,13 +231,13 @@ METHOD: void swipeWithEvent: id event
|
|||
[
|
||||
self event
|
||||
dup -> deltaX sgn {
|
||||
{ 1 [ left-action send-action$ drop ] }
|
||||
{ -1 [ right-action send-action$ drop ] }
|
||||
{ 1 [ left-action send-action$ ] }
|
||||
{ -1 [ right-action send-action$ ] }
|
||||
{ 0
|
||||
[
|
||||
dup -> deltaY sgn {
|
||||
{ 1 [ up-action send-action$ drop ] }
|
||||
{ -1 [ down-action send-action$ drop ] }
|
||||
{ 1 [ up-action send-action$ ] }
|
||||
{ -1 [ down-action send-action$ ] }
|
||||
{ 0 [ 2drop ] }
|
||||
} case
|
||||
]
|
||||
|
|
@ -249,27 +251,39 @@ METHOD: char acceptsFirstResponder [ 1 ]
|
|||
METHOD: id validRequestorForSendType: id sendType returnType: id returnType
|
||||
[
|
||||
! We return either self or nil
|
||||
self window world-focus sendType returnType
|
||||
self window [
|
||||
world-focus sendType returnType
|
||||
valid-service? [ self ] [ f ] if
|
||||
] [ f ] if*
|
||||
]
|
||||
|
||||
METHOD: char writeSelectionToPasteboard: id pboard types: id types
|
||||
[
|
||||
NSStringPboardType types CF>string-array member? [
|
||||
self window world-focus gadget-selection
|
||||
self window [
|
||||
world-focus gadget-selection
|
||||
[ pboard set-pasteboard-string 1 ] [ 0 ] if*
|
||||
] [ 0 ] if*
|
||||
] [ 0 ] if
|
||||
]
|
||||
|
||||
METHOD: char readSelectionFromPasteboard: id pboard
|
||||
[
|
||||
self window :> window
|
||||
window [
|
||||
pboard pasteboard-string
|
||||
[ self window user-input 1 ] [ 0 ] if*
|
||||
[ window user-input 1 ] [ 0 ] if*
|
||||
] [ 0 ] if
|
||||
]
|
||||
|
||||
! Text input
|
||||
METHOD: void insertText: id text
|
||||
[ text CF>string self window user-input ]
|
||||
[
|
||||
self window :> window
|
||||
window [
|
||||
text CF>string window user-input
|
||||
] when
|
||||
]
|
||||
|
||||
METHOD: char hasMarkedText [ 0 ]
|
||||
|
||||
|
|
@ -293,7 +307,12 @@ METHOD: NSInteger conversationIdentifier [ self alien-address ]
|
|||
|
||||
! Initialization
|
||||
METHOD: void updateFactorGadgetSize: id notification
|
||||
[ self view-dim self window dim<< yield ]
|
||||
[
|
||||
self window :> window
|
||||
window [
|
||||
self view-dim window dim<< yield
|
||||
] when
|
||||
]
|
||||
|
||||
METHOD: void doCommandBySelector: SEL selector [ ]
|
||||
|
||||
|
|
@ -309,7 +328,8 @@ METHOD: void dealloc
|
|||
[
|
||||
self remove-observer
|
||||
self SUPER-> dealloc
|
||||
] ;
|
||||
]
|
||||
]
|
||||
|
||||
: sync-refresh-to-screen ( GLView -- )
|
||||
-> openGLContext -> CGLContextObj NSOpenGLCPSwapInterval 1 <int>
|
||||
|
|
@ -321,29 +341,29 @@ METHOD: void dealloc
|
|||
: save-position ( world window -- )
|
||||
-> frame CGRect-top-left 2array >>window-loc drop ;
|
||||
|
||||
CLASS: {
|
||||
{ +name+ "FactorWindowDelegate" }
|
||||
{ +superclass+ "NSObject" }
|
||||
}
|
||||
|
||||
CLASS: FactorWindowDelegate < NSObject
|
||||
[
|
||||
METHOD: void windowDidMove: id notification
|
||||
[
|
||||
notification -> object -> contentView window
|
||||
notification -> object save-position
|
||||
[ notification -> object save-position ] when*
|
||||
]
|
||||
|
||||
METHOD: void windowDidBecomeKey: id notification
|
||||
[
|
||||
notification -> object -> contentView window
|
||||
focus-world
|
||||
[ focus-world ] when*
|
||||
]
|
||||
|
||||
METHOD: void windowDidResignKey: id notification
|
||||
[
|
||||
forget-rollover
|
||||
notification -> object -> contentView
|
||||
dup -> isInFullScreenMode 0 =
|
||||
[ window [ unfocus-world ] when* ] [ drop ] if
|
||||
notification -> object -> contentView :> view
|
||||
view window :> window
|
||||
window [
|
||||
view -> isInFullScreenMode 0 =
|
||||
[ window unfocus-world ] when
|
||||
] when
|
||||
]
|
||||
|
||||
METHOD: char windowShouldClose: id notification [ 1 ]
|
||||
|
|
@ -352,7 +372,8 @@ METHOD: void windowWillClose: id notification
|
|||
[
|
||||
notification -> object -> contentView
|
||||
[ window ungraft ] [ unregister-window ] bi
|
||||
] ;
|
||||
]
|
||||
]
|
||||
|
||||
: install-window-delegate ( window -- )
|
||||
FactorWindowDelegate install-delegate ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue