[GWL] The following changes the application name on the menu bar in [MacOS X]: === if {[[string equal $tcl_platform(os) Darwin]]} { if {![[catch {package require tclCarbonProcesses}]] && [[llength [[info commands ::carbon::setProcessName]]]]} { carbon::setProcessName [[carbon::getCurrentProcess]] {MyApp} } } === [DAS] note that '''[[carbon::setProcessName]]''' is only available starting with '''tclCarbonProcesses 1.1''', and that it uses undocumented SPI that may break in future versions of [MacOS X]. It also will not do everything you want (e.g. it does not change the application name in the Dock), a better way to change the application name is to package your script as a [MacOS X] application bundle and set the correct name in its '''Info.plist''' file. See also the example on [Ffidl] for a way to access the '''setProcessName''' functionality without '''tclCarbonProcesses'''. ---- ** tclCarbonProcesses extension ** [Critcl] wrapper for Mac OS X Process Manager services, c.f. [http://developer.apple.com/documentation/Carbon/Reference/Process_Manager/] for details. Part of [CarbonCritLib]: http://rutherglen.ics.mq.edu.au/~steffen/tcltk/carboncritlib/tclCarbonProcesses.tcl ''[[ [DAS] 06/10/07 ]]'' === #!/bin/sh # ####################################################################### # # tclCarbonProcesses.tcl # # Critcl wrapper for Mac OS X Process 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: # mail: Mathematics Departement # Macquarie University NSW 2109 Australia # www: # # RCS: @(#) $Id$ # # BSD License: c.f. # # Copyright (c) 2005-2007, Daniel A. Steffen # 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 critcl -pkg "$0" "$@" package require critcl if {![[::critcl::compiling]]} {error "No compiler found"} #--------------------------------------------------------------------------------------------------- package provide tclCarbonProcesses 1.1 namespace eval carbon { if {[[llength [[info commands ::critcl::framework]]]]} { ::critcl::framework Carbon } else { lappend ::critcl::v::compile -framework Carbon } ::critcl::ccode { #include OSStatus CPSSetProcessName(ProcessSerialNumber *psn, char* name); static char *OSErrDesc(OSErr err) { static char desc[[255]]; sprintf(desc, "OS Error: %d.", err); return desc; } static void CFKeyVal2TclList(const void *key, const void *value, void *context) { const void *a[[3]] = {key, value, NULL}, **p = a; for (p=a; *p; p++) { Tcl_Obj *str = NULL; CFStringRef desc; if (CFGetTypeID(*p) != CFStringGetTypeID()) { desc = CFCopyDescription(*p); } else { desc = CFRetain(*p); } if (desc) { Tcl_DString ds, *dsp = NULL; const char *c = CFStringGetCStringPtr(desc, kCFStringEncodingUTF8); if (!c) { int len = CFStringGetMaximumSizeForEncoding( CFStringGetLength(desc), kCFStringEncodingUTF8); dsp = &ds; Tcl_DStringInit(dsp); Tcl_DStringSetLength(dsp, len); if (CFStringGetCString(desc, Tcl_DStringValue(dsp), len+1, kCFStringEncodingUTF8)) { c = Tcl_DStringValue(dsp); } } if (c) str = Tcl_NewStringObj(c, -1); if (dsp) Tcl_DStringFree(dsp); CFRelease(desc); } if (!str) str = Tcl_NewStringObj("", 0); Tcl_ListObjAppendElement(NULL, (Tcl_Obj*)context, str); } } } #--------------------------------------------------------------------------------------------------- # # carbon::getCurrentProcess # # this command returns the process serial number of the current process. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand getCurrentProcess {ClientData ip objc objv} { OSErr err; ProcessSerialNumber psn; if (objc != 1) { Tcl_WrongNumArgs(ip, 1, objv, NULL); return TCL_ERROR; } err = GetCurrentProcess(&psn); if (err != noErr) { Tcl_AppendResult(ip, "Could not get current process: ", OSErrDesc(err), NULL); return TCL_ERROR; } Tcl_SetObjResult(ip, Tcl_NewWideIntObj(*((Tcl_WideInt*)&psn))); return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::getFrontProcess # # this command returns the process serial number of the front process. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand getFrontProcess {ClientData ip objc objv} { OSErr err; ProcessSerialNumber psn; if (objc != 1) { Tcl_WrongNumArgs(ip, 1, objv, NULL); return TCL_ERROR; } err = GetFrontProcess(&psn); if (err != noErr) { Tcl_AppendResult(ip, "Could not get front process: ", OSErrDesc(err), NULL); return TCL_ERROR; } Tcl_SetObjResult(ip, Tcl_NewWideIntObj(*((Tcl_WideInt*)&psn))); return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::getProcesses # # this command returns a list of process serial numbers of all processes. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand getProcesses {ClientData ip objc objv} { OSErr err; ProcessSerialNumber psn = { 0, kNoProcess }; Tcl_Obj *listObj; if (objc != 1) { Tcl_WrongNumArgs(ip, 1, objv, NULL); return TCL_ERROR; } listObj = Tcl_NewListObj(0, NULL); do { err = GetNextProcess(&psn); if (err != noErr && err != procNotFound) { Tcl_AppendResult(ip, "Could not get next process: ", OSErrDesc(err), NULL); return TCL_ERROR; } if ( err == noErr) { Tcl_ListObjAppendElement(ip, listObj, Tcl_NewWideIntObj(*((Tcl_WideInt*)&psn))); } } while (err == noErr); Tcl_SetObjResult(ip, listObj); return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::getProcessInformation psn # # this command returns a list of key-value pairs of process information for the given # process serial number. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand getProcessInformation {ClientData ip objc objv} { Tcl_WideInt wideInt; CFDictionaryRef dict; Tcl_Obj *listObj; if (objc != 2) { Tcl_WrongNumArgs(ip, 1, objv, "psn"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(ip, objv[[1]], &wideInt) != TCL_OK) { return TCL_ERROR; } dict = ProcessInformationCopyDictionary((ProcessSerialNumber*)&wideInt, kProcessDictionaryIncludeAllInformationMask); if (!dict) { Tcl_AppendResult(ip, "Could not get process information", NULL); return TCL_ERROR; } listObj = Tcl_NewListObj(0, NULL); CFDictionaryApplyFunction(dict, &CFKeyVal2TclList, listObj); CFRelease(dict); Tcl_SetObjResult(ip, listObj); return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::getProcessForPID pid # # this command returns the process serial number of the process with the given pid. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand getProcessForPID {ClientData ip objc objv} { OSErr err; pid_t pid; ProcessSerialNumber psn; if (objc != 2) { Tcl_WrongNumArgs(ip, 1, objv, "pid"); return TCL_ERROR; } if (Tcl_GetIntFromObj(ip, objv[[1]], &pid) != TCL_OK) { return TCL_ERROR; } err = GetProcessForPID(pid, &psn); if (err != noErr) { Tcl_AppendResult(ip, "Could not get process for pid: ", OSErrDesc(err), NULL); return TCL_ERROR; } Tcl_SetObjResult(ip, Tcl_NewWideIntObj(*((Tcl_WideInt*)&psn))); return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::setFrontProcess psn ?frontWindowOnly? # # this command activates the process of given process serial number and brings all its windows # to the front (or only the frontmost window if the frontWindowOnly flag is set). # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand setFrontProcess {ClientData ip objc objv} { OSErr err; Tcl_WideInt wideInt; int frontWindowOnly = 0; if (objc != 2 && objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "psn ?frontWindowOnly?"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(ip, objv[[1]], &wideInt) != TCL_OK) { return TCL_ERROR; } if (objc == 3 && Tcl_GetBooleanFromObj(ip, objv[[2]], &frontWindowOnly) != TCL_OK) { return TCL_ERROR; } err = SetFrontProcessWithOptions((ProcessSerialNumber*)&wideInt, frontWindowOnly ? kSetFrontProcessFrontWindowOnly : 0); if (err != noErr) { Tcl_AppendResult(ip, "Could not set front process: ", OSErrDesc(err), NULL); return TCL_ERROR; } return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::showHideProcess psn visible # # this command shows or hides the process of given process serial number, depending on the # visible flag. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand showHideProcess {ClientData ip objc objv} { OSErr err; Tcl_WideInt wideInt; int visible = 0; if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "psn visible"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(ip, objv[[1]], &wideInt) != TCL_OK) { return TCL_ERROR; } if (Tcl_GetBooleanFromObj(ip, objv[[2]], &visible) != TCL_OK) { return TCL_ERROR; } err = ShowHideProcess((ProcessSerialNumber*)&wideInt, visible); if (err != noErr) { Tcl_AppendResult(ip, "Could not showHide process: ", OSErrDesc(err), NULL); return TCL_ERROR; } return TCL_OK; } #--------------------------------------------------------------------------------------------------- # # carbon::setProcessName psn name # # this command sets the application menu name of the given process. # Uses undocumented CPS SPI that will likely break post Tiger. # #--------------------------------------------------------------------------------------------------- ::critcl::ccommand setProcessName {ClientData ip objc objv} { OSErr err; Tcl_WideInt wideInt; if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "psn name"); return TCL_ERROR; } if (Tcl_GetWideIntFromObj(ip, objv[[1]], &wideInt) != TCL_OK) { return TCL_ERROR; } err = CPSSetProcessName((ProcessSerialNumber*)&wideInt, Tcl_GetString(objv[[2]])); if (err != noErr) { Tcl_AppendResult(ip, "CPSSetProcessName failed: ", OSErrDesc(err), NULL); return TCL_ERROR; } return TCL_OK; } } #--------------------------------------------------------------------------------------------------- === <>Package