LispWorks platform-specific tricks

Here are some things I've found out while working with LispWorks on Mac OS X and Windows.

Feel free to use them, and send me an email if you have any questions or suggestions for improvements!

Erik Ronström

DoReMIR Music Research

CAPI stuff

Set Object Size on Mac OS X

Many components in Mac OS X (buttons, checkboxes, etc) support three sizes, normal, reduced and mini. Use this function to set the size of a CAPI pane.

NOTE: The pane must be displayed before running this function, otherwise it will have no OS representation!

( defun cocoa-set-object-size ( object size ) ( let ( ( size-value ( case size ( :normal 0 ) ( :reduced 1 ) ( :mini 2 ) ( t 0 ) ) ) ) ( let ( ( representation ( slot-value object 'capi-internals:representation ) ) ) ( when representation ( objc:invoke ( objc:invoke ( slot-value representation 'capi-cocoa-library::main-view ) "cell" ) "setControlSize:" size-value ) ) ) ) )

Placeholder Text in text-input-pane

Mac version

#+cocoa ( defun set-input-pane-placeholder ( input-pane text ) ( objc:invoke ( objc:invoke ( slot-value ( slot-value input-pane 'capi-internals:representation ) 'capi-cocoa-library::main-view ) "cell" ) "setPlaceholderString:" text ) )

Windows version

;; first register module, this only needs to be run once #+win32 ( fli:register-module :user32 :real-name "User32" :connection-style :manual ) ;; define a fli version of SendMessageW #+win32 ( fli:define-foreign-function ( win32-send-message-w-ulong-ptr "SendMessageW" ) ( ( hwnd hwnd ) ( msg ( :unsigned :long ) ) ( wparam ( :unsigned :long ) ) ( lparam :pointer ) ) :result-type :int :calling-convention :cdecl :module :user32 ) ;; this is the message code we are going to send #+win32 ( defconstant EM_SETCUEBANNER #x1501 ) ;; the actual function ;; NOTE: the third parameter to win32-send-message-w-ulong-ptr, ;; the wParam, can be set to 1 instead of 0 if the cue banner should show ;; even when the edit control has focus. This is not the default ;; behavior on Windows. For more information, see ;; http://msdn.microsoft.com/en-us/library/bb761639%28VS.85%29.aspx #+win32 ( defun set-input-pane-placeholder ( input-pane text ) ( let ( ( hwnd ( capi:simple-pane-handle input-pane ) ) ( external-format ( if ( string = ( software-type ) "Windows NT" ) :unicode :ascii ) ) ( unless ( or ( null hwnd ) ( zerop hwnd ) ) ( fli:with-foreign-string ( new-ptr element-count byte-count :external-format external-format ) text ( declare ( ignore element-count byte-count ) ) ( win32-send-message-w-ulong-ptr hwnd EM_SETCUEBANNER 0 new-ptr ) ) ) ) )

Set NSView Background Color

On Mac OS X, you can scroll beyond the actual content of a pane. If the pane has a background set, this scrolling will reveal some white background, which is quite ugly. This function fixes this.

( defun cocoa-set-scroll-view-background ( pane &optional ( color ( capi:simple-pane-background pane ) ) ) ( let ( ( color-spec ( color:get-color-spec color ) ) ) ( when color-spec ( let ( ( nscolor ( objc:invoke "NSColor" "colorWithDeviceRed:green:blue:alpha:" ( * 1.0 ( color:color-red color-spec ) ) ( * 1.0 ( color:color-green color-spec ) ) ( * 1.0 ( color:color-blue color-spec ) ) 1.0 ) ) ) ( when nscolor ( objc:invoke ( slot-value ( capi-internals:representation pane ) 'capi-cocoa-library::scroll-view ) "setBackgroundColor:" nscolor ) ) ) ) ) )

Hide Window Buttons

( defun cocoa-hide-window-buttons ( interface ) ( when ( capi-internals:representation interface ) ( loop for i from 0 to 2 do ( objc:invoke ( objc:invoke ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) "standardWindowButton:" i ) "setHidden:" 1 ) ) ) )

NOTE: You don't need to hide all three buttons. To keep e.g. only the red close button, use loop for i from 1 to 2 do .

Full Screen Support

This function adds full screen support to an interface (the small arrows in the top right corner).

Unfortunately, there is no way to catch the event when the user activates the full screen mode, so the interface is just resized.

( defun cocoa-add-full-screen-support ( interface ) ( ignore-errors ( when ( capi-internals:representation interface ) ( let ( ( representation ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) ) ) ;; Full-screen support requires OS X 10.7. ;; Therefore, we do a simple version check by testing for the existance ;; of a (completely unrelated) method that doesn't exist until 10.7. ;; (We can't test setCollectionBehavior directly, since the _function_ existst prior to 10.7, ;; though it does not handle the full screen flag) ( when ( and representation ( objc:invoke representation "respondsToSelector:" ( objc:coerce-to-selector "backingScaleFactor" ) ) ) ;; Everything seems to be ok. Enable full-screen! ( objc:invoke representation "setCollectionBehavior:" 128 ) ) ) ) ) )

Selectable Toolbar Buttons

The following code enables selectable toolbar buttons. To use it, create an interface with some toolbar buttons, and call cocoa-add-toolbar-delegate on the interface. By default, it makes all tool buttons selectable, but this can be changed by providing the keyword :selectable-items.

The two other "exported" functions are cocoa-set-allow-toolbar-customization , which enables or disables user customization of the toolbar, and cocoa-set-toolbar-selected-item , which programmatically sets the selected item of the toolbar. The latter accepts either a string identifying the button, or a capi:toolbar-button instance. nil is also accepted, which deselects all buttons in the toolbar.

TODO: There is no function to get the selected button, but it should be possible to achieve by calling selectedItemIdentifier on the NSToolbar and then match the result to the existing toolbar-buttons.

NOTE: I've encountered some bugs regarding toolbar customization in connection with this code, but I don't remember exactly what it was. To be safe, don't enable customization when using selectable toolbar buttons. Or debug it! :)

( objc:define-objc-class cocoa-toolbar-delegate ( ) ( ( allowed-items :initarg :allowed-items :initform nil :reader allowed-items ) ( selectable-items :initarg :selectable-items :initform nil :reader selectable-items ) ( default-items :initarg :default-items :initform nil :reader default-items ) ) ( :objc-class-name "SCToolbarDelegate" ) ) ;; Helper ( defun cocoa-toolbar-button-identifier ( button ) ( typecase button ( null nil ) ( capi:toolbar-button ( slot-value button 'capi::button-representation ) ) ( string button ) ( t ( error "~a is not a tool-button" button ) ) ) ) ;; Helper ( defun cocoa-toolbar-button-identifiers ( buttons ) ( loop for item in buttons collect ( cocoa-toolbar-button-identifier item ) ) ) ;; Define some delegate methods ( objc:define-objc-method ( "toolbarSelectableItemIdentifiers:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( toolbar objc:objc-object-pointer ) ) ( declare ( ignorable toolbar ) ) ( make-array ( length ( selectable-items self ) ) :initial-contents ( cocoa-toolbar-button-identifiers ( selectable-items self ) ) ) ) ( objc:define-objc-method ( "toolbarDefaultItemIdentifiers:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( toolbar objc:objc-object-pointer ) ) ( declare ( ignorable toolbar ) ) ( make-array ( length ( default-items self ) ) :initial-contents ( cocoa-toolbar-button-identifiers ( default-items self ) ) ) ) ( objc:define-objc-method ( "toolbarAllowedItemIdentifiers:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( toolbar objc:objc-object-pointer ) ) ( declare ( ignorable toolbar ) ) ( make-array ( length ( allowed-items self ) ) :initial-contents ( cocoa-toolbar-button-identifiers ( allowed-items self ) ) ) ) ;; The delegate needs to implement all methods in the NSToolbarDelegate Protocol, ;; so we have to define these methods even though we are not using them ( objc:define-objc-method ( "toolbarWillAddItem:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( a objc:objc-object-pointer ) ) ( declare ( ignore a ) ) nil ) ( objc:define-objc-method ( "toolbarWillRemoveItem:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( a objc:objc-object-pointer ) ) ( declare ( ignore a ) ) nil ) ( objc:define-objc-method ( "toolbar:itemForItemIdentifier:willBeInsertedIntoToolbar:" objc:objc-object-pointer :lisp ) ( ( self cocoa-toolbar-delegate ) ( a objc:objc-object-pointer ) ( b objc:objc-object-pointer ) ( c objc:objc-object-pointer ) ) ( declare ( ignore a b c ) ) nil ) ;; Main entry point for the outside world ( defun cocoa-add-toolbar-delegate ( interface &key ( allow-customization nil ) selectable-items selected-item ) ( let * ( ( toolbar ( objc:invoke ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) "toolbar" ) ) ( tool-buttons ( capi:interface-toolbar-items interface ) ) ( delegate ( make-instance 'cocoa-toolbar-delegate :allowed-items ( copy-list tool-buttons ) :default-items ( copy-list tool-buttons ) :selectable-items ( or selectable-items ( copy-list tool-buttons ) ) ) ) ( selected ( if selected-item ( cocoa-toolbar-button-identifier selected-item ) ) ) ) ( objc:invoke ( objc:invoke ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) "toolbar" ) "setDelegate:" ( objc:objc-object-pointer delegate ) ) ( objc:invoke toolbar "setAllowsUserCustomization:" ( if allow-customization 1 0 ) ) ( objc:invoke toolbar "setSelectedItemIdentifier:" selected ) ) ) ;; Also "exported" ( defun cocoa-set-allow-toolbar-customization ( interface allow-p ) ( let ( ( toolbar ( objc:invoke ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) "toolbar" ) ) ) ( objc:invoke toolbar "setAllowsUserCustomization:" ( if allow-p 1 0 ) ) ) ) ;; Also "exported" ( defun cocoa-set-toolbar-selected-item ( interface button-or-identifier ) ( let ( ( toolbar ( objc:invoke ( slot-value ( capi-internals:representation interface ) 'capi-cocoa-library::window ) "toolbar" ) ) ( ident ( cocoa-toolbar-button-identifier button-or-identifier ) ) ) ( objc:invoke toolbar "setSelectedItemIdentifier:" ident ) ) )

Other stuff

Get OS Language

Mac version:

#+cocoa ( defun default-language ( ) ( objc:with-autorelease-pool ( ) ( objc:invoke-into 'string ( objc:invoke ( objc:invoke "NSUserDefaults" "standardUserDefaults" ) "objectForKey:" "AppleLanguages" ) "objectAtIndex:" 0 ) ) )

Windows version:

#+win32 ( fli:define-foreign-function ( get-system-default-language-id "GetSystemDefaultLangID" ) ( ) :result-type :int ) #+win32 ( defun default-language ( ) ;; Map language id to code ( case ( mod ( get-system-default-language-id ) 1024 ) ; we are only interested in the primary language, which resides in the last 10 bits ( #x09 "en" ) ( #x11 "ja" ) ( #x1D "sv" ) ( #x41 "sw" ) ;; Add more languages here... ;; A complete list of supported languages is available ;; in the Windows documentation of GetSystemDefaultLangID, see ;; http://msdn.microsoft.com/en-us/library/windows/desktop/dd318693%28v=vs.85%29.aspx ( t "unknown" ) ) ) ; fallback

Check modifier keys

The function modifier-key-pressed takes a keyword representing a modifier key, and returns true if that key is currently being pressed (or activated for CAPS LOCK).

Supported keywords are :shift , :control , :alt , :caps-lock and :command (Mac only).