Critcl wrapper for Mac OS X HICommand Carbon Event Manager services, c.f. [L1 ] for details and [L2 ] for OS defined commandIDs.
[ Daniel Steffen 31/01/05 ]
#!/bin/sh # ####################################################################### # # tclCarbonHICommand.tcl # # Critcl wrapper for Mac OS X HICommand Carbon Event Manager services. # # Process this file with 'critcl -pkg' to build a loadable package (or # simply source this file if [package require critcl] and a compiler # are available at deployment). # # # Author: Daniel A. Steffen # E-mail: <[email protected]> # mail: Mathematics Departement # Macquarie University NSW 2109 Australia # www: <http://www.maths.mq.edu.au/~steffen/> # # RCS: @(#) $Id: 13463,v 1.3 2005-02-01 07:01:34 jcw Exp $ # # BSD License: c.f. <http://www.opensource.org/licenses/bsd-license> # # Copyright (c) 2005, Daniel A. Steffen <[email protected]> # All rights reserved. # # Redistribution and use in source and binary forms, with or # without modification, are permitted provided that the following # conditions are met: # # * Redistributions of source code must retain the above # copyright notice, this list of conditions and the # following disclaimer. # # * Redistributions in binary form must reproduce the above # copyright notice, this list of conditions and the following # disclaimer in the documentation and/or other materials # provided with the distribution. # # * Neither the name of Macquarie University nor the names of its # contributors may be used to endorse or promote products derived # from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL MACQUARIE # UNIVERSITY OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS # OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR # TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE # USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH # DAMAGE. # # ####################################################################### # \ exec tclsh "$0" "$@" package require critcl if {![::critcl::compiling]} {error "No compiler found"} #--------------------------------------------------------------------------------------------------- package provide tclCarbonHICommand 1.0 namespace eval carbon { ::critcl::tk ::critcl::config I /Library/Frameworks/Tk.framework/Headers lappend ::critcl::v::compile -framework Carbon ::critcl::ccode { #define Cursor _Cursor #include <Carbon/Carbon.h> typedef struct TkWindowPrivate { Tk_Window *winPtr; CGrafPtr grafPtr; } TkWindowPrivate; char *OSErrDesc(OSErr err) { static char desc[255]; if (err == eventNotHandledErr) { sprintf(desc, "Carbon Event not handled.\n", err); } else { sprintf(desc, "OS Error: %d.\n", err); } return desc; } } #--------------------------------------------------------------------------------------------------- # # carbon::processHICommand commandID toplevel # # this command takes a Carbon HICommand ID (4 char string, c.f. CarbonEvents.h), and either the # name of a toplevel window (for window specific HICommands) or an empty string (for menu specific # HICommands) and calls ProcessHICommand() with the resulting HICommandExtended structure. # #--------------------------------------------------------------------------------------------------- ::critcl::cproc processHICommand {Tcl_Interp* ip char* commandID char* toplevel} ok { OSErr err; HICommandExtended command; EventRef event; bzero(&command, sizeof(HICommandExtended)); if (strlen(commandID) != sizeof(UInt32)) { Tcl_AppendResult(ip, "Argument commandID needs to be exactly 4 chars long", NULL); return TCL_ERROR; } memcpy(&(command.commandID), commandID, sizeof(UInt32)); if (strlen(toplevel)) { Tk_Window tkwin = Tk_NameToWindow(ip,toplevel,Tk_MainWindow(ip)); if(!tkwin) return TCL_ERROR; if(!Tk_IsTopLevel(tkwin)) { Tcl_AppendResult(ip, "Window \"", toplevel, "\" is not a toplevel window", NULL); return TCL_ERROR; } command.source.window = GetWindowFromPort( ((TkWindowPrivate*)Tk_WindowId(tkwin))->grafPtr); command.attributes = kHICommandFromWindow; } else { err = GetIndMenuItemWithCommandID(NULL, command.commandID, 1, &command.source.menu.menuRef, &command.source.menu.menuItemIndex); if ( err != noErr) { Tcl_AppendResult(ip, "Could not find menu item corresponding to commandID: ", OSErrDesc(err), NULL); } else { command.attributes = kHICommandFromMenu; } } err = ProcessHICommand((HICommand*)&command); if ( err != noErr) { Tcl_AppendResult(ip, "Could not process command: ", OSErrDesc(err), NULL); return TCL_ERROR; } return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::enableMenuCommand commandID disable # # this command takes a Carbon HICommand ID (4 char string, c.f. CarbonEvents.h) of a menu specific # HICommand, and a flag specifing whether to enable (0) or disable (1) the associated menu item. # #--------------------------------------------------------------------------------------------------- ::critcl::cproc enableMenuCommand {Tcl_Interp* ip char* commandID int disable} ok { MenuCommand command; if (strlen(commandID) != sizeof(UInt32)) { Tcl_AppendResult(ip, "Argument commandID needs to be exactly 4 chars long", NULL); return TCL_ERROR; } memcpy(&command, commandID, sizeof(UInt32)); if (disable) { DisableMenuCommand(NULL, command); } else { EnableMenuCommand(NULL, command); } return TCL_OK; } } #---------------------------------------------------------------------------------------------------