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 edit
Critcl wrapper for Mac OS X Process Manager services, c.f. [
1] 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: <steffen@maths.mq.edu.au>
# mail: Mathematics Departement
# Macquarie University NSW 2109 Australia
# www: <http://www.maths.mq.edu.au/~steffen/>
#
# RCS: @(#) $Id$
#
# BSD License: c.f. <http://www.opensource.org/licenses/bsd-license>
#
# Copyright (c) 2005-2007, Daniel A. Steffen <das@users.sourceforge.net>
# 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 <Carbon/Carbon.h>
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;
}
}
#---------------------------------------------------------------------------------------------------
