[View]  [Edit]  [Lock]  [References]  [Attachments]  [History]  [Home]  [Changes]  [Search]  [Help] 

api[osx,AppKit] methods

" IMPORTANT Note:
	The AppKit API is under development.
	It implements the support for minimal testing and needs work.
"

NSObject
	subclass: #NSColor
	category: #AppKit!

! NSColor class methodsFor: #instantiation !
withRed: red green: green blue: blue alpha: alpha

	^self @ (
	    self nativeClass
		colorWithRed: red green: green blue: blue
		alpha: alpha)! !

! NSColor class methodsFor: #instantiation !
red: red green: green blue: blue alpha: alpha

	^self withRed: red green: green blue: blue alpha: alpha! !

! NSColor class methodsFor: #instantiation !
r: red g: green b: blue alpha: alpha

	^self withRed: red green: green blue: blue alpha: alpha! !

! NSColor class methodsFor: #instantiation !
r: red g: green b: blue

	^self withRed: red green: green blue: blue alpha: 1! !


#(	black blue brown
	clear cyan darkGray
	gray green lightGray
	magenta orange purple
	red white yellow

	alternateSelectedControl
	alternateSelectedControlText
	controlBackground
	control
	controlHighlight
	controlLightHighlight
	controlShadow
	controlDarkShadow
	controlText
	disabledControlText
	grid
	header
	headerText
	highlight
	keyboardFocusIndicator
	knob
	scrollBar
	secondarySelectedControl
	selectedControl
	selectedControlText
	selectedMenuItem
	selectedMenuItemText
	selectedTextBackground
	selectedText
	selectedKnob
	shadow
	textBackground
	text
	windowBackground
	windowFrame
	windowFrameText
	underPageBackground
) do: [:each|
	NSColor class
		implement: each
		comment: 'Return the ' ,each ,' instance of the receiver.'
		as: '^self @ (self nativeClass basicAt: #',each,'Color)'
		category: #constants
]!

NSObject
	subclass: #NSResponder
	category: #AppKit!

NSResponder buildBooleanGetters: #(
	acceptsFirstResponder
	canBecomeFirstResponder
	canResignFirstResponder
	isFirstResponder
)!
NSResponder buildBooleanAccessors: #(
	becomeFirstResponder
	resignFirstResponder
)!
NSResponder buildTypedAccessors: #(
	#(nextResponder #NSResponder )
	#(userActivity #NSUserActivity )
	#(menu #NSMenu )
)!
NSResponder buildTypedGetters: #(
	#(undoManager #NSUndoManager )
)!
NSResponder buildFunctions: #(
	#(#validateProposedFirstResponder:forEvent: #( #(responder handle) #(event json) ) )
	invalidateRestorableState
	#(#presentError: #(#(error handle)))
	#(#tryToPerform:with: #(aSelector #(anObject json)))
	#(#doCommandBySelector: #(selector))
	#(#noResponderFor: #(selector))
	#(#shouldBeTreatedAsInkEvent: #(#(event json)))
)!

NSResponder
	subclass: #NSWindow
	category: #AppKit!
NSWindow comment: '
	Manage and coordinate the windows an application displays on the screen.
'!

NSWindow buildNumberGetters: #(
	windowNumber
)!
NSWindow buildNumberAccessors: #(
	styleMask alphaValue
)!
NSWindow buildBooleanAccessors: #(
	canHide hidesOnDeactivate
	opaque hasShadow
)!
NSWindow buildBooleanGetters: #(
	worksWhenModal
)!
NSWindow buildTypedGetters: #(
	#( frame #CGRect )
)!
NSWindow buildTypedAccessors: #(
	#( delegate #NSObject )
	#( backgroundColor #NSColor )
	#( colorSpace #NSColorSpace )
	#( contentView #NSView )
	#( collectionBehavior #NSWindowCollectionBehavior )
	#( windowController #NSWindowController )
	#( attachedSheet #NSWindow )
	#( sheetParent #NSWindow )
)!
NSWindow buildFunctions: #(
	#(#toggleFullScreen: #( #(sender handle) ))
	#invalidateShadow
	#(#autorecalculatesContentBorderThicknessForEdge: #( #(aNSRectEdge hadle) ))
	#(#setAutorecalculatesContentBorderThickness:forEdge: #( aBoolean #(aNSRectEdge handle) ))
	#(#contentBorderThicknessForEdge: #( #(aNSRectEdge handle) ))
	#(#setContentBorderThickness:forEdge: #( aFloat #(aNSRectEdge handle) ))
	#preventsApplicationTerminationWhenModal
	#deviceDescription
	#update
)!

! NSWindow class methodsFor: #instantiation !
withContentRect: aCGRect
	styleMask: windowStyle
	backing: bufferingType
        defer: deferCreation

	^self @ (
	    self nativeClass
		windowWithContentRect: (CGRect instance: aCGRect) handle
		styleMask: windowStyle
		backing: bufferingType
        	defer: deferCreation)! !

! NSWindow class methodsFor: #instantiation !
withContentRect: aCGRect
	styleMask: windowStyle
	backing: bufferingType
        defer: deferCreation
	screen: screen

	^self @ (
	    self nativeClass
		windowWithContentRect: (CGRect instance: aCGRect) handle
		styleMask: windowStyle
		backing: bufferingType
        	defer: deferCreation
		screen: screen handle)! !

NSObject
	subclass: #NSLayoutConstraint
	category: #AppKit!
NativeObject
	subclass: #NSLayoutConstraintsArray
	category: #AppKit!
NSLayoutConstraintsArray comment: '
	Opaque constraints array.
	See NSLayoutConstraint class>>#constraintsWithVisualFormat:options:metrics:views:
'!

NSLayoutConstraint buildNumberAccessors: #(
	constant priority
)!
NSLayoutConstraint buildBooleanAccessors: #(
	shouldBeArchived
)!
NSLayoutConstraint buildNumberGetters: #(
	firstAttribute secondAttribute
	multiplier relation
)!
NSLayoutConstraint buildTypedGetters: #(
	#( firstItem  #NSObject )
	#( secondItem #NSObject )
)!

! NSLayoutConstraint class methodsFor: #instantiation !
constraintsWithVisualFormat: format options: opts metrics: metrics views: views
	" Create constraints described by an ASCII art-like visual format string. "

	^NSLayoutConstraintsArray @ (
	    self nativeClass
		constraintsWithVisualFormat: format
		options: opts
		metrics: (self asJson: metrics)
		views: (self asJson: views))! !

! NSLayoutConstraint class methodsFor: #instantiation !
constraintsWithVisualFormat: format options: opts views: views
	" Create constraints described by an ASCII art-like visual format string. "

	^self constraintsWithVisualFormat: format options: opts metrics: nil views: views! !

! NSLayoutConstraint class methodsFor: #instantiation !
constraintsWithVisualFormat: format metrics: metrics views: views
	" Create constraints described by an ASCII art-like visual format string. "

	^self constraintsWithVisualFormat: format options: 0 metrics: metrics views: views! !

! NSLayoutConstraint class methodsFor: #instantiation !
constraintsWithVisualFormat: format views: views
	" Create constraints described by an ASCII art-like visual format string. "

	^self constraintsWithVisualFormat: format options: 0 metrics: nil views: views! !

! NSLayoutConstraint class methodsFor: #instantiation !
constraintWithItem: view1 attribute: attr1 relatedBy: relation
	toItem: view2 attribute: attr2 multiplier: multiplier constant: c
	" Create a constraint of the form
		view1.attr1 <relation> view2.attr2 * multiplier + constant
	"

	^self @ (self nativeClass
		constraintWithItem: view1 json
		attribute: attr1 relatedBy: relation
		toItem: view2 json
		attribute: attr2
		multiplier: multiplier constant: c )! !

NSResponder subclass: #NSViewController!
NSViewController buildTypedGetters: #(
	#( bottomLayoutGuide #NSObject )
	#( editButtonItem #NSBarButtonItem )
	#( extensionContext #NSExtensionContext )
	#( navigationController #NSNavigationController )
	#( navigationItem #NSNavigationItem )
	#( nibBundle #NSBundle )
	#( parentViewController #NSViewController )
	#( popoverPresentationController #NSPopoverPresentationController )
	#( presentedViewController #NSViewController )
	#( presentationController #NSPresentationController )
	#( presentingViewController #NSViewController )
	#( searchDisplayController #NSSearchDisplayController )
	#( splitViewController #NSSplitViewController )
	#( storyboard #NSStoryboard )
	#( topLayoutGuide #NSObject )
)! 
NSViewController buildTypedAccessors: #(
	#( representedObject #NSObject )
	#( view #NSView )
	#( tabBarItem #NSTabBarItem )
	#( searchDisplayController #NSSearchDisplayController )
	#( preferredContentSize #CGSize )
	#( transitioningDelegate #NSObject )
)!
NSViewController buildAccessors: #(
	title restorationIdentifier
	toolbarItems
	edgesForExtendedLayout
)!
NSViewController buildGetters: #(
	nibName
)!
NSViewController buildNumberAccessors: #(
	interfaceOrientation
	modalPresentationStyle
	modalTransitionStyle
)!
NSViewController buildBooleanAccessors: #(
	automaticallyAdjustsScrollViewInsets
	definesPresentationContext
	editing
	extendedLayoutIncludesOpaqueBars
	hidesBottomBarWhenPushed
	modalInPopover
	modalPresentationCapturesStatusBarAppearance
	providesPresentationContextTransitionStyle
)!
NSViewController buildBooleanGetters: #(
	isBeingDismissed isBeingPresented
	isMovingFromParentViewController isMovingToParentViewController
	isViewLoaded
)!
NSViewController buildFunctions: #(
	#( #addChildViewController: #( #(anNSViewController handle) ) )
	#( #beginAppearanceTransition:animated: #( isAppearing animated ) )
	#( #canPerformUnwindSegueAction:fromViewController:withSender: #( selector #(anNSViewController handle) sender ) )
	#( #dismissViewControllerAnimated:completion: #( animated #(aBlock json) ) )
	disablesAutomaticKeyboardDismissal
	endAppearanceTransition
	loadView
	#( #performSegueWithIdentifier:sender: #( identifier sender ) )
	prefersStatusBarHidden
	#( #prepareForSegue:sender: #( segue sender ) )
	#( #presentViewController:animated:completion: #( #(anNSViewController handle) animated #(aBlock json) ) )
	removeFromParentViewController
	#( #setToolbarItems:animated: #( toolbarItems animated ) )
	#( #showViewController:sender: #( #(anNSViewController handle) #(sender handle) ) )
	#( #showDetailViewController:sender: #( #(anNSViewController handle) #(sender handle) ) )
	#( #targetViewControllerForAction:sender: #( action #(sender handle) ) )
	transitionCoordinator
	updateViewConstraints
)!

! NSViewController class methodsFor: #instantiation !
withNibName: aName bundle: aNSBundle
	" Return an instance of the receiver. "

"self print: '// ',self name,' withNibName: ',aName toString,' bundle: ',aNSBundle toString.
"	^self @ (self nativeClass
		instanceWithNibName: aName
		bundle: aNSBundle json)! !

! NSViewController class methodsFor: #instantiation !
withNibName: aName
	" Return an instance of the receiver. "

	^self withNibName: aName bundle: self bundle! !

! NSViewController class methodsFor: #instantiation !
fromNib
	" Return an instance of the receiver. "

	^self withNibName: self nibName bundle: self bundle! !

! NSViewController class methodsFor: #instantiation !
fromBundle
	" Return an instance of the receiver. "

	^self fromBundle: self bundle! !

! NSViewController class methodsFor: #instantiation !
fromBundle: aBundle
	" Return an instance of the receiver. "

	| storyboard aName |
	storyboard := self storyboardIn: aBundle.
	(storyboard notNil and: [
		aName := self identifier.
		aName notNil ]) ifTrue: [
		^self fromStoryboard: storyboard withIdentifier: aName
	].
	^self withNibName: self nibName bundle: aBundle! !

! NSViewController class methodsFor: #instantiation !
fromStoryboard: storyboard
	" Return an instance of the receiver. "

	| instance |
	instance := storyboard instantiateInitialViewController.
	^instance notNil ifTrue: [ self @ instance handle ]! !

! NSViewController class methodsFor: #instantiation !
fromStoryboard: storyboard withIdentifier: aName
	" Return an instance of the receiver. "

	| instance |
	instance := storyboard instantiateViewControllerWithIdentifier: aName.
	^instance notNil ifTrue: [ self @ instance handle ]! !

! NSViewController class methodsFor: #loading !
storyboardIn: aBundle
	" Private - Return the storyboard of the receiver in aBundle (or nil). "

	| aName |
	aName := self storyboardName.
	^aName notNil ifTrue: [ NSStoryboard withName: aName bundle: aBundle ]! !

! NSViewController class methodsFor: #loading !
identifier
	" Return the identifier of the receiver (in storyboard or nil). "

	^self name! !

! NSViewController class methodsFor: #loading !
storyboardName
	" Return the storyboard name of the receiver (or nil). "

	^nil! !

! NSViewController class methodsFor: #loading !
nibName
	" Return the nib file name of the receiver. "

	^self name! !

! NSViewController class methodsFor: #loading !
bundle
	" Return the bundle of the receiver. "

	^nil! !

! NSViewController methodsFor: #accessing !
childViewControllers
	" Return the child viewControllers of the receiver. "

	^(self asArray: (self handle basicAt: #childViewControllers))
		collect: [:each| NSViewController @ each ]! !

! NSViewController methodsFor: #gui !
presentViewController: aViewController
	^self
		presentViewController: aViewController
		animated: true
		completion: nil! !

NSResponder subclass: #NSView!
NSView buildBooleanGetters: #(
	canDraw
)!
NSView buildBooleanAccessors: #(
	autoresizesSubviews
	hidden opaque
	wantsLayer wantsUpdateLayer
	canDrawSubviewsIntoLayer
	layerUsesCoreImageFilters
	canDrawConcurrently
	needsDisplay
)!
NSView buildNumberAccessors: #(
	alphaValue
	autoresizingMask
	tag
	layerContentsPlacement
	layerContentsRedrawPolicy
	frameRotation
	boundsRotation
	frameCenterRotation
)!
NSView buildTypedGetters: #(
	#(superview #NSView)
	#(enclosingMenuItem #NSMenuItem)
	#(visibleRect #CGRect)
)!
NSView buildTypedAccessors: #(
	#(frame #CGRect)
	#(bounds #CGRect)
	#(layer #CALayer)
	#(compositingFilter #CIFilter)
	#(shadow #NSShadow)
)!
NSView buildFunctions: #(
	prepareForReuse
	#(#setSubviews: #(#(subviews handles)) )
	#(#addSubview: #(#(view json)) )
	#(#addSubview:positioned:relativeTo: #( #(view json) place #(otherView json)) )
	removeFromSuperview
	removeFromSuperviewWithoutNeedingDisplay
	#(#replaceSubview:with: #( #(oldView json) #(newView json)) )
	#(#isDescendantOf: #( #(view json) ) )
	#(#ancestorSharedWithView: #( #(view json) ) #NSView)
	#(#setFrameOrigin: #(#(aNSPoint handle)))
	#(#setFrameSize: #(#(aNSSize handle)))
	#(#setBoundsOrigin: #(#(aNSPoint handle)))
	#(#setBoundsSize: #(#(aNSSize handle)))
	#(#makeBackingLayer #() #CALayer)
	#(#viewWithTag: #( tag ) #NSView)
	#updateLayer
	#(#drawRect: #(#(dirtyRect handle)) )

	"Converting Coordinate Values"
	#(#backingAlignedRect:options: #(#(aRect handle) options) #NSRect )
	#(#convertPointFromBacking: #(#(aNSPoint handle)) #NSPoint )
	#(#convertPointToBacking:   #(#(aNSPoint handle)) #NSPoint )
	#(#convertPointFromLayer: #(#(aNSPoint handle)) #NSPoint )
	#(#convertPointToLayer:   #(#(aNSPoint handle)) #NSPoint )
	#(#convertRectFromBacking: #(#(aNSRect handle)) #NSRect )
	#(#convertRectToBacking:   #(#(aNSRect handle)) #NSRect )
	#(#convertRectFromLayer: #(#(aNSRect handle)) #NSRect )
	#(#convertRectToLayer:   #(#(aNSRect handle)) #NSRect )
	#(#convertSizeFromBacking: #(#(aNSSize handle)) #NSSize )
	#(#convertSizeToBacking:   #(#(aNSSize handle)) #NSSize )
	#(#convertSizeFromLayer: #(#(aNSSize handle)) #NSSize )
	#(#convertSizeToLayer:   #(#(aNSSize handle)) #NSSize )
	#(#convertPoint:fromView: #(#(aNSPoint handle) #(aNSView handle)) #NSPoint )
	#(#convertPoint:toView:   #(#(aNSPoint handle) #(aNSView handle)) #NSPoint )
	#(#convertSize:fromView: #(#(aNSSize handle) #(aNSView handle)) #NSSize )
	#(#convertSize:toView:   #(#(aNSSize handle) #(aNSView handle)) #NSSize )
	#(#convertRect:fromView: #(#(aNSRect handle) #(aNSView handle)) #NSRect )
	#(#convertRect:toView:   #(#(aNSRect handle) #(aNSView handle)) #NSRect )
	#(#centerScanRect: #(#(aNSRect handle)) #NSRect )

	"Modifying the Coordinate System"
	#(#translateOriginToPoint: #(#(aNSPoint handle)))
	#(#scaleUnitSquareToSize: #(#(aNSSize handle)))
	#(#rotateByAngle: #(angle))
)!

! NSView class methodsFor: #instantiation !
withFrame: aCGRect
	" Return an instance of the receiver. "

	^self @ (self nativeClass instanceWithFrame: (CGRect instance: aCGRect) handle)! !

! NSView class methodsFor: #appearance !
appearance
	" Return the appearance proxy instance of the receiver.
	See NSAppearance Protocol Reference
	"

	^self @ (self nativeClass basicAt: #appearance)! !

! NSView methodsFor: #constraints !
constraints
	" Return the (opaque) constraints array. "

	^NSLayoutConstraintsArray @ (self handle basicAt: #constraints)! !

! NSView methodsFor: #accessing !
subviews
	" Return the subviews of the receiver. "

	^(self asArray: (self handle basicAt: #subviews))
		collect: [:each| NSView @ each ]! !

! NSView methodsFor: #accessing !
subviews: anArray
	" Set the subviews of the receiver. "

	^self setSubviews: anArray! !

! NSView methodsFor: #accessing !
backgroundFilters
	" Return the backgroundFilters of the receiver. "

	^(self asArray: (self handle basicAt: #backgroundFilters))
		collect: [:each| CIFilter @ each ]! !

! NSView methodsFor: #accessing !
backgroundFilters: anArray
	" Set the backgroundFilters of the receiver. "

	^self handle basicAt: #backgroundFilters put: anArray handles! !

! NSView methodsFor: #accessing !
contentFilters
	" Return the contentFilters of the receiver. "

	^(self asArray: (self handle basicAt: #contentFilters))
		collect: [:each| CIFilter @ each ]! !

! NSView methodsFor: #accessing !
contentFilters: anArray
	" Set the contentFilters of the receiver. "

	^self handle basicAt: #contentFilters put: anArray handles! !

! NSView methodsFor: #resize !
autoresizing: masks
	" Set the autoresizing masks of the receiver. "

	masks isArray ifTrue: [
		^self autoresizingMask: (self class autoresizingMasks: masks for: self)
	].
	^self autoresizing: (Array with: masks)! !

! NSView class methodsFor: #resize !
autoresizingMasks: masks for: aView
	" Private - Return the resizing mask constant for masks. "

	^masks inject: 0 into: [:total :each|
		total + (self autoresizingMask: each for: aView)
	]! !

! NSView class methodsFor: #constants !
autoresizingMask: aConstant for: aView
	" Private - Return the value for mask constant. "

	| names values index |
	aConstant isNil ifTrue: [ ^0 ].
	aConstant isNumber ifTrue: [ ^aConstant ].
	#current = aConstant ifTrue: [ ^aView autoresizingMask ].
	#width = aConstant ifTrue: [ ^self autoresizingMask: #widthSizable for: aView ].
	#height = aConstant ifTrue: [ ^self autoresizingMask: #heightSizable for: aView ].
	(#(extent extentSizable size both) includes: aConstant) ifTrue: [
		^self autoresizingMasks: #( width height ) for: aView
	].
	values := #(0 1 2 4 8 16 32).
	names := #(
		notSizable
		minXMargin widthSizable maxXMargin
		minYMargin heightSizable maxYMargin
	).
	index := names indexOf: aConstant.
	index > 0 ifTrue: [ ^values at: index ].
	(aConstant indexOf: #NSView) = 1 ifTrue: [
		index := names indexOf: (aConstant copyFrom: 7 to: aConstant size).
		index > 0 ifTrue: [ ^values at: index ].	
	].
	^self error: 'Unknown resize constant #',aConstant! !

! NSView methodsFor: #adding !
addSubview: aView above: anotherOrNil
	" Add aView to the receiver. "

	^self	addSubview: aView
		positioned: 1"NSWindowAbove"
		relativeTo: anotherOrNil! !

! NSView methodsFor: #adding !
addSubview: aView below: anotherOrNil
	" Add aView to the receiver. "

	^self	addSubview: aView
		positioned: -1"NSWindowBelow"
		relativeTo: anotherOrNil! !


NSView subclass: #NSTableCellView !
NSTableCellView buildNumberAccessors: #(
	backgroundStyle
	rowSizeStyle
)!
NSTableCellView buildTypedAccessors: #(
	#( objectValue #NSObject )
	#( imageView #NSImageView )
	#( textField #NSTextField )
)!

! NSTableCellView methodsFor: #accessing !
draggingImageComponents
	" Returns dragging images of the receiver. "

	^(self asArray: (self handle basicAt: #draggingImageComponents))
		collect: [:each| NSDraggingImageComponent @ each ]! !

NSView subclass: #NSControl!
NSControl buildBooleanGetters: #(
	#isEnabled #isSelected
)!
NSControl buildBooleanAccessors: #(
	allowsExpansionToolTips
	refusesFirstResponder
	ignoresMultiClick
)!
NSControl buildNumberAccessors: #(
	doubleValue floatValue intValue integerValue
	tag
)!
NSControl buildAccessors: #(
	objectValue stringValue
	baseWritingDirection
	action
)!
NSControl buildTypedAccessors: #(
	#(attributedStringValue #NSAttributedString)
	#(alignment #NSTextAlignment)
	#(font #NSFont)
	#(formatter #NSObject)
	#(currentEditor #NSText)
	#(target #NSObject)
)!
NSControl buildFunctions: #(
	#(#takeDoubleValueFrom: #( #(aNSControl handle) ) )
	#(#takeFloatValueFrom: #( #(aNSControl handle) ) )
	#(#takeIntValueFrom: #( #(aNSControl handle) ) )
	#(#takeIntegerValueFrom: #( #(aNSControl handle) ) )
	#(#takeObjectValueFrom: #( #(aNSControl handle) ) )
	#(#takeStringValueFrom: #( #(aNSControl handle) ) )
	abortEditing validateEditing
	sizeToFit
)!

NSControl buildFunctions: #(
	#(#sendAction:to: #(selector #(target handle) ) )
	#(#sendActionOn: #(mask) )
	#(#performClick: #( #(sender handle) ) )
	#(#mouseDown: #( #(aNSEvent handle) ) )
	#(#invalidateIntrinsicContentSizeForCell: #(#(aNSCell handle)))
)!

NSControl subclass: #NSButton!
NSButton buildAccessors: #(
	alternateTitle title
	keyEquivalent
)!
NSButton buildNumberAccessors: #(
	imagePosition
	bezelStyle
	state
	keyEquivalentModifierMask
)!
NSButton buildBooleanAccessors: #(
	bordered transparent
	showsBorderOnlyWhileMouseInside
	allowsMixedState
)!
NSButton buildTypedAccessors: #(
	#(attributedTitle #NSAttributedString)
	#(sound #NSSound)
	#(image #NSImage)
	#(alternateImage #NSImage)
)!
NSButton buildFunctions: #(
	#(#setButtonType: #(anInteger))
	#(#getPeriodicDelay:interval: #(delay interval))
	#(#setPeriodicDelay:interval: #(delay interval))
	setNextState
	#(#highlight: #(boolean))
	#(#performKeyEquivalent: #(#(anEvent handle)))
)!


NSControl subclass: #NSTableView !
NSTableView buildAccessors: #(
	alternateTitle title
	keyEquivalent
	doubleAction
	autosaveName
)!
NSTableView buildGetters: #(
	registeredNibsByIdentifier
)!
NSTableView buildNumberAccessors: #(
	imagePosition bezelStyle
	state
	keyEquivalentModifierMask
	intercellSpacing
	rowHeight
	selectionHighlightStyle
	gridStyleMask
	rowSizeStyle
	columnAutoresizingStyle
	draggingDestinationFeedbackStyle
)!
NSTableView buildNumberGetters: #(
	clickedColumn clickedRow
	effectiveRowSizeStyle
	numberOfSelectedColumns
	selectedColumn
	selectedRow
	numberOfSelectedRows
	numberOfColumns
	numberOfRows
	editedColumn
	editedRow
)!
NSTableView buildBooleanAccessors: #(
	bordered transparent
	showsBorderOnlyWhileMouseInside
	allowsMixedState
	usesStaticContents
	allowsColumnReordering allowsColumnResizing
	allowsMultipleSelection allowsEmptySelection
	allowsColumnSelection
	usesAlternatingRowBackgroundColors
	allowsTypeSelect
	floatsGroupRows
	autosaveTableColumns
	verticalMotionCanBeginDrag
)!
NSTableView buildTypedGetters: #(
	#(selectedColumnIndexes #NSIndexSet)
	#(selectedRowIndexes #NSIndexSet)
)!
NSTableView buildTypedAccessors: #(
	#(attributedTitle #NSAttributedString)
	#(sound #NSSound)
	#(image #NSImage)
	#(alternateImage #NSImage)
	#(dataSource #NSObject)
	#(backgroundColor #NSColor)
	#(gridColor #NSColor)
	#(headerView #NSTableHeaderView)
	#(cornerView #NSView)
	#(delegate #NSObject)
	#(highlightedTableColumn #NSTableColumn)
)!
NSTableView buildFunctions: #(
	#(#makeViewWithIdentifier:owner: #(identifier #(owner handle)) #NSView)
	#(#rowViewAtRow:makeIfNecessary: #(row makeIfNecessary) #NSTableRowView)
	#(#viewAtColumn:row:makeIfNecessary: #(collumn row makeIfNecessary) #NSView)
	reloadData
	#(#reloadDataForRowIndexes:columnIndexes: #( #(rowsNSIndexSet handle) #(columnsNSIndexSet handle)))
	beginUpdates endUpdates
	#(#columnForView: #(#(aView handle)))
	#(#rowForView: #(#(aView handle)))
	#(#moveRowAtIndex:toIndex: #(from to))
	#(#insertRowsAtIndexes:withAnimation: #(#(indexes handle) animationOptions))
	#(#removeRowsAtIndexes:withAnimation: #(#(indexes handle) animationOptions))
	#(#registerNib:forIdentifier: #(#(nib handle) identifier))
	#(#setIndicatorImage:inTableColumn: #(#(image handle) #(aTableColumn handle) ))
	#(#indicatorImageInTableColumn: #(#(aTableColumn handle)) #NSImage)
	#(#addTableColumn: #(#(aNSTableColumn handle)))
	#(#removeTableColumn: #(#(aNSTableColumn handle)))
	#(#moveColumn:toColumn: #(fromIndex toIndex))
	#(#columnWithIdentifier: #(identifier))
	#(#tableColumnWithIdentifier: #(identifier) #NSTableColumn)
	#(#selectColumnIndexes:byExtendingSelection: #(#(indexes handle) aBoolean))
	#(#deselectColumn: #(index))
	#(#isColumnSelected: #(index))
	#(#selectRowIndexes:byExtendingSelection: #(#(indexes handle) aBoolean))
	#(#deselectRow: #(index))
	#(#isRowSelected: #(index))
	#(#selectAll: #(#(sender handle)))
	#(#deselectAll: #(#(sender handle)))
	#(#editColumn:row:withEvent:select: #( columnIndex rowIndex #(event handle) flag))
	#(#rectOfColumn: #(index) #NSRect)
	#(#rectOfRow: #(index) #NSRect)
	#(#rowsInRect: #(#(aNSRect handle)) #NSRange)
	#(#columnIndexesInRect: #(#(aNSRect handle)) #NSIndexSet)
	#(#columnAtPoint: #(#(aNSPoint handle)))
	#(#rowAtPoint: #(#(aNSPoint handle)))
	#(#frameOfCellAtColumn:row: #(columnIndex rowIndex) #NSRect)
	sizeLastColumnToFit noteNumberOfRowsChanged
	tile sizeToFit
	#(#noteHeightOfRowsWithIndexesChanged: #(#(indexSet handle)))
	#(#drawRow:clipRect: #(index #(clipRect handle)))
	#(#drawGridInClipRect: #(#(clipRect handle)))
	#(#highlightSelectionInClipRect: #(#(clipRect handle)))
	#(#drawBackgroundInClipRect: #(#(clipRect handle)))
	#(#scrollRowToVisible: #(index))
	#(#scrollColumnToVisible: #(index))
	#(#dragImageForRowsWithIndexes:tableColumns:event:offset: #(#(dragRows handle) tableColumns #(dragEvent handle) dragImageOffset) #NSImage)
	#(#canDragRowsWithIndexes:atPoint: #(#(rowIndexes handle) #(mouseDownPoint handle)))
	#(#canDragRowsWithIndexes:atPoint: #(#(rowIndexes handle) #(mouseDownPoint handle)))
	#(#setDraggingSourceOperationMask:forLocal: #(mask isLocal))
	#(#setDropRow:dropOperation: #(index operation))
)!

! NSTableView methodsFor: #accessing !
tableColumns
	" Return an array containing the current table columns of the receiver. "

	^(self asArray: self handle tableColumns)
		collect: [:each| NSTableColumn @ each ]! !


NSObject
	subclass: #NSScreen
	category: #AppKit!

NSScreen buildGetters: #(
	deviceDescription
)!
NSScreen buildTypedGetters: #(
	#(frame #NSRect)
	#(visibleFrame #NSRect)
	#(colorSpace #NSColorSpace)
)!
NSScreen buildNumberGetters: #(
	depth backingScaleFactor
)!
NSScreen buildFunctions: #(
	#(#backingAlignedRect:options: #(#(aNSRect handle) options) #NSRect )
	#(#convertRectFromBacking: #(#(aNSRect handle)) #NSRect)
	#(#convertRectToBacking: #(#(aNSRect handle)) #NSRect)
)!

! NSScreen class methodsFor: #instantiation !
mainScreen
	" Return an instance of the receiver. "

	^self @ (self nativeClass basicAt: #mainScreen)! !

! NSScreen class methodsFor: #instantiation !
deepestScreen
	" Return an instance of the receiver. "

	^self @ (self nativeClass basicAt: #deepestScreen)! !

! NSScreen class methodsFor: #accessing !
screensHaveSeparateSpaces
	" Returns a Boolean value that indicates whether each screen can have its own set of spaces. "

	^self nativeClass basicAt: #screensHaveSeparateSpaces! !

! NSScreen class methodsFor: #accessing !
screens
	" Return the existing instances of the receiver. "

	^(self asArray: (self nativeClass basicAt: #screens))
		collect: [:each| self @ each ]! !

! NSScreen class methodsFor: #accessing !
boundingBox
	" Return the boundingBox (aRectangle) of the main screen. "

	^self mainScreen boundingBox! !

! NSScreen class methodsFor: #accessing !
boundingRect
	" Return the boundingRect (aCGRect) of the main screen. "

	^CGRect @ self mainScreen boundingRect! !

! NSScreen class methodsFor: #accessing !
applicationBox
	" Return the applicationBox (aRectangle) of the main screen. "

	^self mainScreen applicationBox! !

! NSScreen class methodsFor: #accessing !
applicationRect
	" Return the applicationRect (aCGRect) of the main screen. "

	^CGRect @ self mainScreen applicationRect! !

! NSScreen methodsFor: #accessing !
oriented: aRectangle
	" Return aRectangle corrected to current orientation. "

	| orientation |
	orientation := NSApplication sharedApplication statusBarOrientation.
	(#( 1 2 ) includes: orientation) ifFalse: [ ^aRectangle ].
	^aRectangle left @ aRectangle top extent: aRectangle height @ aRectangle width! !

! NSScreen methodsFor: #accessing !
boundingBox
	" Return the boundingBox (aRectangle) of the receiver. "

	^self oriented: self bounds asRectangle! !

! NSScreen methodsFor: #accessing !
boundingRect
	" Return the boundingBox (aCGRect) of the receiver. "

	^self boundingBox asCGRect! !

! NSScreen methodsFor: #accessing !
applicationBox
	" Return the application frame (aRectangle) of the receiver. "

	^self oriented: self applicationFrame asRectangle! !

! NSScreen methodsFor: #accessing !
applicationRect
	" Return the application frame (aCGRect) of the receiver. "

	^self applicationBox asCGRect! !

! NSScreen methodsFor: #snapshot !
snapshotViewAfterScreenUpdates: afterUpdates
	" Return a snapshot view based on the current contents. "

	^NSView @ (self handle snapshotViewAfterScreenUpdates: afterUpdates)! !


NSControl subclass: #NSImageView!
NSImageView buildNumberAccessors: #(
	imageFrameStyle
	imageAlignment
	imageScaling
)!
NSImageView buildBooleanAccessors: #(
	editable animates
	allowsCutCopyPaste
)!
NSImageView buildTypedAccessors: #(
	#(image #NSImage)
)!

! NSImageView class methodsFor: #instantiation !
withImage: anNSImage
	" Return an instance of the receiver. "

	| result |
	result := self @ self nativeClass instance.
	result image: anNSImage.
	^result! !

NSObject
	subclass: #NSImage
	category: #AppKit!

NSImage buildAccessors: #(
	name accessibilityDescription
)!
NSImage buildBooleanAccessors: #(
	prefersColorMatch
	usesEPSOnResolutionMismatch
	matchesOnMultipleResolution
	matchesOnlyOnBestFittingAxis
)!
NSImage buildTypedAccessors: #(
	#(size #NSSize)
	#(backgroundColor #NSColor)
	#(alignmentRect #NSRect)
	#(delegate #NSObject)
)!
NSImage buildNumberAccessors: #(
	cacheMode
)!
NSImage buildFunctions: #(
	#isTemplate
	#(#setTemplate: #(aBoolean))
	#(#addRepresentation: #(#(imageRep handle)))
	#(#removeRepresentation: #(#(imageRep handle)))
	#(#addRepresentations: #(#(imageReps handles)))
	#(#bestRepresentationForRect:context:hints: #( #(rect handle) #(referenceContext json) #(hints json) ) #NSImageRep)
	#(#drawInRect: #(#(aNSRect json)))
	#(#drawAtPoint:fromRect:operation:fraction: #( #(point handle) #(srcRect handle) op delta))
	#(#drawInRect:fromRect:operation:fraction: #( #(dstRect handle) #(srcRect handle) op delta))
	#(#drawInRect:fromRect:operation:fraction:respectFlipped:hints: #( #(dstRect handle) #(srcRect handle) op delta respectFlipped #(hints json)))
	#(#drawRepresentation:inRect: #(#(aNSImageRep handle) #(aNSRect json)))
	lockFocus unlockFocus
	#(#lockFocusFlipped: #(flipped))
	recache cancelIncrementalLoad
	#(#hitTestRect:withImageDestinationRect:context:hints:flipped: #( #(testRectDestSpace handle) #(imageRectDestSpace handle) #(referenceContext handle) #(hints json) flipped))
	#(#layerContentsForContentsScale: #(layerContentsScale) #NSObject)
	#(#recommendedLayerContentsScale: #(preferredContentsScale))
)!

! NSImage methodsFor: #accessing !
tiffRepresentation
	" Returns a data object containing TIFF data for all of the image representations in the receiver. "

	^NSData @ (self handle basicAt: #TIFFRepresentation)! !

! NSImage methodsFor: #accessing !
tiffRepresentationUsingCompression: compression factor: factor
	" Returns a data object containing TIFF data for all of the image representations in the receiver. "

	^NSData @ (self handle basicAt: #TIFFRepresentationUsingCompression: compression factor: factor)! !

! NSImage methodsFor: #accessing !
cgImageForProposedRect: proposedDestRect
	context: referenceContext
	hints: hints
	" Returns a CGImage capturing the drawing of the receiver. "

	^CGImageRef @ (self handle
		#CGImageForProposedRect: proposedDestRect handle
		context: referenceContext handle
		hints: hints json)! !

! NSImage methodsFor: #accessing !
representations
	" Return the representations of the receiver. "

	^(self asArray: (self handle basicAt: #representations))
		collect: [:each| NSImageRep @ each ]! !

! NSImage class methodsFor: #instantiation !
byReferencingFile: path
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceByReferencingFile: path)! !

! NSImage class methodsFor: #instantiation !
byReferencingURL: aNSURL
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceByReferencingURL: aNSURL handle)! !

! NSImage class methodsFor: #instantiation !
withContentsOfFile: path
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWithContentsOfFile: path)! !

! NSImage class methodsFor: #instantiation !
withContentsOfURL: aNSURL
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWithContentsOfURL: aNSURL handle)! !

! NSImage class methodsFor: #instantiation !
animatedImageNamed: imageName duration: duration
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass animatedImageNamed: imageName duration: duration)! !

! NSImage class methodsFor: #instantiation !
withData: aNSData
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWithData: aNSData handle)! !

! NSImage class methodsFor: #instantiation !
withDataIgnoringOrientation: aNSData
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWithDataIgnoringOrientation: aNSData handle)! !

! NSImage class methodsFor: #instantiation !
withPasteboard: pasteboard
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWithPasteboard: pasteboard handle)! !

! NSImage class methodsFor: #query !
canInitWithPasteboard: pasteboard
	" Tests whether the receiver can create an instance of itself using pasteboard data. "

	^self nativeClass canInitWithPasteboard: pasteboard handle! !

! NSImage class methodsFor: #instantiation !
withSize: aNSSize
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass instanceWSize: aNSSize handle)! !

! NSImage class methodsFor: #instantiation !
named: imageName
	" Return an instance of the receiver(or nil). "

	imageName isNil ifTrue: [ ^nil ].
	imageName isString ifTrue: [
		^self @ (self nativeClass imageNamed: '',imageName)
	].
	imageName do: [:each| | result |
		result := self named: each.
		result notNil ifTrue: [ ^result ].
	].
	^nil! !

! NSImage class methodsFor: #accessing !
imageTypes
	" Returns an array of UTI strings identifying the image types supported by the registered NSImageRep objects, either directly or through a user-installed filter service. "

	^self nativeClass basicAt: #imageTypes! !

! NSImage class methodsFor: #accessing !
imageUnfilteredTypes
	" Returns an array of UTI strings identifying the image types supported directly by the registered image representation objects. "

	^self nativeClass basicAt: #imageUnfilteredTypes! !

NSObject
	subclass: #NSGraphicsContext
	category: #AppKit!

NSGraphicsContext buildGetters: #(
	attributes
)!
NSGraphicsContext buildBooleanAccessors: #(
	shouldAntialias
)!
NSGraphicsContext buildNumberAccessors: #(
	compositingOperation
	imageInterpolation
	colorRenderingIntent
)!
NSGraphicsContext buildTypedAccessors: #(
	#(patternPhase #NSPoint)
)!
NSGraphicsContext buildFunctions: #(
	restoreGraphicsState
	saveGraphicsState
	flushGraphics
)!

! NSGraphicsContext methodsFor: #accessing !
graphicsPort
	" Returns the low-level, platform-specific graphics context represented by the receiver. "

	^CGContext @ (self handle basicAt: #graphicsPort)! !

! NSGraphicsContext methodsFor: #accessing !
ciContext
	" Returns a CIContext object that you can use to render into the receiver. "

	^CIContext @ (self handle basicAt: #CIContext)! !

! NSGraphicsContext class methodsFor: #instantiation !
graphicsContextWithAttributes: attributes
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass graphicsContextWithAttributes: attributes json)! !

! NSGraphicsContext class methodsFor: #instantiation !
graphicsContextWithBitmapImageRep: aNSBitmapImageRep
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass graphicsContextWithBitmapImageRep: aNSBitmapImageRep handle)! !

! NSGraphicsContext class methodsFor: #instantiation !
graphicsContextWithWindow: aNSWindow
	" Return an instance of the receiver(or nil). "

	^self @ (self nativeClass graphicsContextWithWindow: aNSWindow handle)! !

! NSGraphicsContext class methodsFor: #singleton !
currentContext: aNSGraphicsContext
	" Set the current instance of the receiver. "

	self nativeClass setCurrentContext: aNSGraphicsContext handle! !

! NSGraphicsContext class methodsFor: #singleton !
currentContext
	" Return an instance of the receiver. "

	^self @ (self nativeClass basicAt: #currentContext)! !

! NSGraphicsContext class methodsFor: #singleton !
current
	" Return an instance of the receiver. "

	^self @ (self nativeClass basicAt: #currentContext)! !

! NSGraphicsContext class methodsFor: #state !
restoreGraphicsState
	" Pops a graphics context from the per-thread stack, makes it current, and sends the context a restoreGraphicsState message. "

	^self nativeClass restoreGraphicsState! !

! NSGraphicsContext class methodsFor: #state !
saveGraphicsState
	" Saves the graphics state of the current graphics context. "

	^self nativeClass saveGraphicsState! !

! NSGraphicsContext class methodsFor: #state !
currentContextDrawingToScreen
	" Returns a Boolean value that indicates whether the current context is drawing to the screen. "

	^(1 #& (self nativeClass basicAt: #currentContextDrawingToScreen)) notNil! !

NSObject
	subclass: #NSEvent
	category: #AppKit!

NSEvent buildNumberGetters: #(
	timestamp type windowNumber
	eventRef modifierFlags
	keyCode buttonNumber
	clickCount pressure
	eventNumber trackingNumber
	userData
	data1 data2 subtype
	deltaX deltaY deltaZ
	capabilityMask deviceID
	pointingDeviceID pointingDeviceSerialNumber pointingDeviceType
	systemTabletID tabletID uniqueID
	vendorID vendorPointingDeviceType
	absoluteX absoluteY absoluteZ
	buttonMask rotation tangentialPressure tilt
	magnification
	scrollingDeltaX scrollingDeltaY
	momentumPhase phase
)!
NSEvent buildBooleanGetters: #(
	hasPreciseScrollingDeltas
)!
NSEvent buildGetters: #(
	characters
	charactersIgnoringModifiers
)!
NSEvent buildTypedGetters: #(
	#(context #NSGraphicsContext)
	#(locationInWindow #NSPoint)
	#(window #NSWindow)
	#(cgEvent #CGEventRef)
	#(trackingArea #NSTrackingArea)
	#(vendorDefined #NSObject)
)!
NSEvent buildFunctions: #(
	#(#touchesMatchingPhase:inView: #(phase #(view handle)) #NSSet )
	#(#addGlobalMonitorForEventsMatchingMask:handler: #(mask #(block json)) #NSObject )
	#(#addLocalMonitorForEventsMatchingMask:handler: #(mask #(block json)) #NSObject )
	#(#removeMonitor: #(#(eventMonitor handle)) )
	#(#trackSwipeEventWithOptions:dampenAmountThresholdMin:max:usingHandler: #(options minDampenThreshold maxDampenThreshold #(block json)) )
)!

! NSEvent class methodsFor: #instantiation !
withType: type location: location
	modifierFlags: flags timestamp: time
	windowNumber: windowNum context: context
	characters: characters
	charactersIgnoringModifiers: unmodCharacters
	isARepeat: repeatKey keyCode: code
	" Returns an instance of the receiver. "

	^self @ (self nativeClass
		keyEventWithType: type
                     location: location json
                modifierFlags: flags
                    timestamp: time
		 windowNumber: windowNum
                      context: context json
                   characters: characters
  charactersIgnoringModifiers: unmodCharacters
                    isARepeat: repeatKey
                      keyCode: code)! !

! NSEvent class methodsFor: #instantiation !
withType: type location: location
	modifierFlags: flags timestamp: time
	windowNumber: windowNum context: context
	eventNumber: eventNumber
	clickCount: clickNumber
	pressure: pressure
	" Returns an instance of the receiver. "

	^self @ (self nativeClass
		mouseEventWithType: type
                     location: location json
                modifierFlags: flags
                    timestamp: time
		 windowNumber: windowNum
                      context: context json
                  eventNumber: eventNumber
                   clickCount: clickNumber
                     pressure: pressure)! !

! NSEvent class methodsFor: #instantiation !
withType: type location: location
	modifierFlags: flags timestamp: time
	windowNumber: windowNum context: context
	eventNumber: eventNumber
	trackingNumber: trackingNumber
	userData: userData
	" Returns an instance of the receiver. "

	^self @ (self nativeClass
		enterExitEventWithType: type
                     location: location json
                modifierFlags: flags
                    timestamp: time
		 windowNumber: windowNum
                      context: context json
                  eventNumber: eventNumber
               trackingNumber: trackingNumber
                     userData: userData json)! !

! NSEvent class methodsFor: #instantiation !
withType: type location: location
	modifierFlags: flags timestamp: time
	windowNumber: windowNum context: context
	subtype: subtype
	data1: data1 data2: data2
	" Returns an instance of the receiver. "

	^self @ (self nativeClass
		enterExitEventWithType: type
                     location: location json
                modifierFlags: flags
                    timestamp: time
		 windowNumber: windowNum
                      context: context json
                      subtype: subtype
                        data1: data1
                        data2: data2)! !

! NSEvent class methodsFor: #instantiation !
withEventRef: eventRef
	" Returns an instance of the receiver. "

	^self @ (self nativeClass eventWithEventRef: eventRef json)! !

! NSEvent class methodsFor: #instantiation !
withCGEvent: cgEvent
	" Returns an instance of the receiver. "

	^self @ (self nativeClass eventWithCGEvent: cgEvent json)! !

! NSEvent class methodsFor: #accessing !
modifierFlags
	" Returns the currently pressed modifier flags. "

	^self nativeClass basicAt: #modifierFlags! !

! NSEvent class methodsFor: #accessing !
keyRepeatDelay
	" Returns the length of time a key must be held down in order to generate the first key repeat event. "

	^self nativeClass basicAt: #keyRepeatDelay! !

! NSEvent class methodsFor: #accessing !
keyRepeatInterval
	" Returns the length between subsequent key repeat events being posted. "

	^self nativeClass basicAt: #keyRepeatInterval! !

! NSEvent class methodsFor: #accessing !
pressedMouseButtons
	" Returns the indices of the currently depressed mouse buttons. "

	^self nativeClass basicAt: #pressedMouseButtons! !

! NSEvent class methodsFor: #accessing !
doubleClickInterval
	" Returns the time, in seconds, in which a second mouse click must occur in order to be considered a double click. "

	^self nativeClass basicAt: #doubleClickInterval! !

! NSEvent class methodsFor: #accessing !
mouseLocation
	" Reports the current mouse position in screen coordinates. "

	^NSPoint @ (self nativeClass basicAt: #mouseLocation)! !

! NSEvent class methodsFor: #accessing !
mouseCoalescingEnabled: flag

	^self nativeClass setMouseCoalescingEnabled: flag == true! !

! NSEvent class methodsFor: #accessing !
mouseCoalescingEnabled

	^self nativeClass basicAt: #isMouseCoalescingEnabled! !

! NSEvent class methodsFor: #accessing !
startPeriodicEventsAfterDelay: delaySeconds withPeriod: periodSeconds

	^self nativeClass
		startPeriodicEventsAfterDelay: delaySeconds
		withPeriod: periodSeconds! !

! NSEvent class methodsFor: #accessing !
stopPeriodicEvents

	^self nativeClass basicAt: #stopPeriodicEvents! !

! NSEvent class methodsFor: #accessing !
isSwipeTrackingFromScrollEventsEnabled

	^self nativeClass basicAt: #isSwipeTrackingFromScrollEventsEnabled! !

! NSEvent methodsFor: #location !
locationInView: aNSView
	" Return the location of the receiver relative to aNSView coordinates. "

	^aNSView convertPoint: self locationInWindow fromView: nil! !