Critcl wrapper for Mac OS X Process Manager services, c.f. [L1 ] for details.
[ Daniel Steffen 04/02/05 ]
#!/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: <[email protected]> # mail: Mathematics Departement # Macquarie University NSW 2109 Australia # www: <http://www.maths.mq.edu.au/~steffen/> # # RCS: @(#) $Id: 13478,v 1.2 2005-02-05 07:01:14 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 tclCarbonProcesses 1.0 namespace eval carbon { lappend ::critcl::v::compile -framework Carbon ::critcl::ccode { #include <Carbon/Carbon.h> static char *OSErrDesc(OSErr err) { static char desc[255]; sprintf(desc, "OS Error: %d.\n", 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 psn # # 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; } } #---------------------------------------------------------------------------------------------------