static void
LostSelection(
ClientData clientData) /* Pointer to LostCommand structure. */
{
LostCommand *lostPtr = clientData;
Tcl_Interp *interp = lostPtr->interp;
Tcl_InterpState savedState;
int code;
Tcl_Preserve(interp);
/*
* Execute the command. Save the interpreter's result, if any, and restore
* it after executing the command.
*/
savedState = Tcl_SaveInterpState(interp, TCL_OK);
Tcl_ResetResult(interp);
code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
(void) Tcl_RestoreInterpState(interp, savedState);
/*
* Free the storage for the command, since we're done with it now.
*/
Tcl_DecrRefCount(lostPtr->cmdObj);
ckfree(lostPtr);
Tcl_Release(interp);
}
static Tcl_Obj *Ttk_Use(
Tcl_Interp *interp,
Tcl_HashTable *table,
Allocator allocate,
Tk_Window tkwin,
Tcl_Obj *objPtr)
{
int newEntry;
Tcl_HashEntry *entryPtr =
Tcl_CreateHashEntry(table,Tcl_GetString(objPtr),&newEntry);
Tcl_Obj *cacheObj;
if (!newEntry) {
return Tcl_GetHashValue(entryPtr);
}
cacheObj = Tcl_DuplicateObj(objPtr);
Tcl_IncrRefCount(cacheObj);
if (allocate(interp, tkwin, cacheObj)) {
Tcl_SetHashValue(entryPtr, cacheObj);
return cacheObj;
} else {
Tcl_DecrRefCount(cacheObj);
Tcl_SetHashValue(entryPtr, NULL);
Tcl_BackgroundException(interp, TCL_ERROR);
return NULL;
}
}
static int stateHandlerInvoke(Tcl_Event* p, int flags) {
/* called from Tcl event loop, when the connection status changes */
connectionEvent *cev =(connectionEvent *) p;
pvInfo *info = cev->info;
Tcl_Obj *script = Tcl_DuplicateObj(info->connectprefix);
Tcl_IncrRefCount(script);
/* append cmd of PV and up/down */
Tcl_Obj *cmdname = Tcl_NewObj();
Tcl_GetCommandFullName(info->interp, info->cmd, cmdname);
int code = Tcl_ListObjAppendElement(info->interp, script, cmdname);
if (code != TCL_OK) {
goto bgerr;
}
if (cev->op == CA_OP_CONN_UP) {
info->connected = 1;
/* Retrieve information about type and number of elements */
info->nElem = ca_element_count(info->id);
info->type = ca_field_type(info->id);
} else {
info->connected = 0;
}
code = Tcl_ListObjAppendElement(info->interp, script, Tcl_NewBooleanObj(info->connected));
if (code != TCL_OK) {
goto bgerr;
}
Tcl_Preserve(info->interp);
code = Tcl_EvalObjEx(info->interp, script, TCL_EVAL_GLOBAL);
if (code != TCL_OK) { goto bgerr; }
Tcl_Release(info->interp);
Tcl_DecrRefCount(script);
/* this event was successfully handled */
return 1;
bgerr:
/* put error in background */
Tcl_AddErrorInfo(info->interp, "\n (epics connection callback script)");
Tcl_BackgroundException(info->interp, code);
/* this event was successfully handled */
return 1;
}
static void
AfterProc(
ClientData clientData) /* Describes command to execute. */
{
AfterInfo *afterPtr = clientData;
AfterAssocData *assocPtr = afterPtr->assocPtr;
AfterInfo *prevPtr;
int result;
Tcl_Interp *interp;
/*
* First remove the callback from our list of callbacks; otherwise someone
* could delete the callback while it's being executed, which could cause
* a core dump.
*/
if (assocPtr->firstAfterPtr == afterPtr) {
assocPtr->firstAfterPtr = afterPtr->nextPtr;
} else {
for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
prevPtr = prevPtr->nextPtr) {
/* Empty loop body. */
}
prevPtr->nextPtr = afterPtr->nextPtr;
}
/*
* Execute the callback.
*/
interp = assocPtr->interp;
Tcl_Preserve(interp);
result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (\"after\" script)");
Tcl_BackgroundException(interp, result);
}
Tcl_Release(interp);
/*
* Free the memory for the callback.
*/
Tcl_DecrRefCount(afterPtr->commandPtr);
ckfree(afterPtr);
}
static OSErr
PrefsHandler(
const AppleEvent *event,
AppleEvent *reply,
SRefCon handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::ShowPreferences", &dummy)){
int code = Tcl_GlobalEval(interp, "::tk::mac::ShowPreferences");
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
}
return noErr;
}
static OSErr
OappHandler(
const AppleEvent *event,
AppleEvent *reply,
long handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
if (interp &&
Tcl_GetCommandInfo(interp, "::tk::mac::OpenApplication", &dummy)){
int code = Tcl_GlobalEval(interp, "::tk::mac::OpenApplication");
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
}
return noErr;
}
void
TkWmProtocolEventProc(
TkWindow *winPtr, /* Window to which the event was sent. */
XEvent *eventPtr) /* X event. */
{
WmInfo *wmPtr;
ProtocolHandler *protPtr;
Tcl_Interp *interp;
Atom protocol;
int result;
wmPtr = winPtr->wmInfoPtr;
if (wmPtr == NULL) {
return;
}
protocol = (Atom) eventPtr->xclient.data.l[0];
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protocol == protPtr->protocol) {
Tcl_Preserve(protPtr);
interp = protPtr->interp;
Tcl_Preserve(interp);
result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (command for \"%s\" window manager protocol)",
Tk_GetAtomName((Tk_Window) winPtr, protocol)));
Tcl_BackgroundException(interp, result);
}
Tcl_Release(interp);
Tcl_Release(protPtr);
return;
}
}
/*
* No handler was present for this protocol. If this is a WM_DELETE_WINDOW
* message then just destroy the window.
*/
if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
Tk_DestroyWindow((Tk_Window) winPtr);
}
}
static int
ReallyKillMe(
Tcl_Event *eventPtr,
int flags)
{
Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
Tcl_CmdInfo dummy;
int quit = Tcl_GetCommandInfo(interp, "::tk::mac::Quit", &dummy);
int code = Tcl_GlobalEval(interp, quit ? "::tk::mac::Quit" : "exit");
if (code != TCL_OK) {
/*
* Should be never reached...
*/
Tcl_BackgroundException(interp, code);
}
return 1;
}
int
TkBackgroundEvalObjv(
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv,
int flags)
{
Tcl_InterpState state;
int n, r = TCL_OK;
/*
* Record the state of the interpreter.
*/
Tcl_Preserve(interp);
state = Tcl_SaveInterpState(interp, TCL_OK);
/*
* Evaluate the command and handle any error.
*/
for (n = 0; n < objc; ++n) {
Tcl_IncrRefCount(objv[n]);
}
r = Tcl_EvalObjv(interp, objc, objv, flags);
for (n = 0; n < objc; ++n) {
Tcl_DecrRefCount(objv[n]);
}
if (r == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (background event handler)");
Tcl_BackgroundException(interp, r);
}
/*
* Restore the state of the interpreter.
*/
(void) Tcl_RestoreInterpState(interp, state);
Tcl_Release(interp);
return r;
}
static OSErr
RappHandler(
const AppleEvent *event,
AppleEvent *reply,
SRefCon handlerRefcon)
{
Tcl_CmdInfo dummy;
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
ProcessSerialNumber thePSN = {0, kCurrentProcess};
OSStatus err = ChkErr(SetFrontProcess, &thePSN);
if (interp && Tcl_GetCommandInfo(interp,
"::tk::mac::ReopenApplication", &dummy)) {
int code = Tcl_GlobalEval(interp, "::tk::mac::ReopenApplication");
if (code != TCL_OK){
Tcl_BackgroundException(interp, code);
}
}
return err;
}
/*
* Ttk_UseImage --
* Acquire a Tk_Image from the cache.
*/
Tk_Image Ttk_UseImage(Ttk_ResourceCache cache, Tk_Window tkwin, Tcl_Obj *objPtr)
{
const char *imageName = Tcl_GetString(objPtr);
int newEntry;
Tcl_HashEntry *entryPtr =
Tcl_CreateHashEntry(&cache->imageTable,imageName,&newEntry);
Tk_Image image;
InitCacheWindow(cache, tkwin);
if (!newEntry) {
return Tcl_GetHashValue(entryPtr);
}
image = Tk_GetImage(cache->interp, tkwin, imageName, NullImageChanged,0);
Tcl_SetHashValue(entryPtr, image);
if (!image) {
Tcl_BackgroundException(cache->interp, TCL_ERROR);
}
return image;
}
static void
LostSelection(
ClientData clientData) /* Pointer to LostCommand structure. */
{
LostCommand *lostPtr = clientData;
Tcl_Obj *objPtr;
Tcl_Interp *interp;
int code;
interp = lostPtr->interp;
Tcl_Preserve(interp);
/*
* Execute the command. Save the interpreter's result, if any, and restore
* it after executing the command.
*/
objPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(objPtr);
Tcl_ResetResult(interp);
code = TkCopyAndGlobalEval(interp, lostPtr->command);
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
Tcl_SetObjResult(interp, objPtr);
Tcl_DecrRefCount(objPtr);
Tcl_Release(interp);
/*
* Free the storage for the command, since we're done with it now.
*/
ckfree((char *) lostPtr);
}
static int
HandleTclCommand(
ClientData clientData, /* Information about command to execute. */
int offset, /* Return selection bytes starting at this
* offset. */
char *buffer, /* Place to store converted selection. */
int maxBytes) /* Maximum # of bytes to store at buffer. */
{
CommandInfo *cmdInfoPtr = clientData;
int length;
Tcl_Obj *command;
const char *string;
Tcl_Interp *interp = cmdInfoPtr->interp;
Tcl_InterpState savedState;
int extraBytes, charOffset, count, numChars, code;
const char *p;
/*
* We must also protect the interpreter and the command from being deleted
* too soon.
*/
Tcl_Preserve(clientData);
Tcl_Preserve(interp);
/*
* Compute the proper byte offset in the case where the last chunk split a
* character.
*/
if (offset == cmdInfoPtr->byteOffset) {
charOffset = cmdInfoPtr->charOffset;
extraBytes = strlen(cmdInfoPtr->buffer);
if (extraBytes > 0) {
strcpy(buffer, cmdInfoPtr->buffer);
maxBytes -= extraBytes;
buffer += extraBytes;
}
} else {
cmdInfoPtr->byteOffset = 0;
cmdInfoPtr->charOffset = 0;
extraBytes = 0;
charOffset = 0;
}
/*
* First, generate a command by taking the command string and appending
* the offset and maximum # of bytes.
*/
command = Tcl_ObjPrintf("%s %d %d",
cmdInfoPtr->command, charOffset, maxBytes);
Tcl_IncrRefCount(command);
/*
* Execute the command. Be sure to restore the state of the interpreter
* after executing the command.
*/
savedState = Tcl_SaveInterpState(interp, TCL_OK);
code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL);
Tcl_DecrRefCount(command);
if (code == TCL_OK) {
/*
* TODO: This assumes that bytes are characters; that's not true!
*/
string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
count = (length > maxBytes) ? maxBytes : length;
memcpy(buffer, string, (size_t) count);
buffer[count] = '\0';
/*
* Update the partial character information for the next retrieval if
* the command has not been deleted.
*/
if (cmdInfoPtr->interp != NULL) {
if (length <= maxBytes) {
cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
cmdInfoPtr->buffer[0] = '\0';
} else {
p = string;
string += count;
numChars = 0;
while (p < string) {
p = Tcl_UtfNext(p);
numChars++;
}
cmdInfoPtr->charOffset += numChars;
length = p - string;
if (length > 0) {
strncpy(cmdInfoPtr->buffer, string, (size_t) length);
}
cmdInfoPtr->buffer[length] = '\0';
}
cmdInfoPtr->byteOffset += count + extraBytes;
}
count += extraBytes;
} else {
/*
* Something went wrong. Log errors as background errors, and silently
* drop everything else.
*/
if (code == TCL_ERROR) {
Tcl_AddErrorInfo(interp, "\n (command handling selection)");
Tcl_BackgroundException(interp, code);
}
count = -1;
}
(void) Tcl_RestoreInterpState(interp, savedState);
Tcl_Release(clientData);
Tcl_Release(interp);
return count;
}
void
TkpDisplayScale(
ClientData clientData) /* Widget record for scale. */
{
TkScale *scalePtr = (TkScale *) clientData;
Tk_Window tkwin = scalePtr->tkwin;
Tcl_Interp *interp = scalePtr->interp;
Pixmap pixmap;
int result;
char string[PRINT_CHARS];
XRectangle drawnArea;
Tcl_DString buf;
scalePtr->flags &= ~REDRAW_PENDING;
if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
goto done;
}
/*
* Invoke the scale's command if needed.
*/
Tcl_Preserve(scalePtr);
if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
Tcl_Preserve(interp);
sprintf(string, scalePtr->format, scalePtr->value);
Tcl_DStringInit(&buf);
Tcl_DStringAppend(&buf, scalePtr->command, -1);
Tcl_DStringAppend(&buf, " ", -1);
Tcl_DStringAppend(&buf, string, -1);
result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
Tcl_DStringFree(&buf);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command executed by scale)");
Tcl_BackgroundException(interp, result);
}
Tcl_Release(interp);
}
scalePtr->flags &= ~INVOKE_COMMAND;
if (scalePtr->flags & SCALE_DELETED) {
Tcl_Release(scalePtr);
return;
}
Tcl_Release(scalePtr);
#ifndef TK_NO_DOUBLE_BUFFERING
/*
* In order to avoid screen flashes, this function redraws the scale in a
* pixmap, then copies the pixmap to the screen in a single operation.
* This means that there's no point in time where the on-sreen image has
* been cleared.
*/
pixmap = Tk_GetPixmap(scalePtr->display, Tk_WindowId(tkwin),
Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
#else
pixmap = Tk_WindowId(tkwin);
#endif /* TK_NO_DOUBLE_BUFFERING */
drawnArea.x = 0;
drawnArea.y = 0;
drawnArea.width = Tk_Width(tkwin);
drawnArea.height = Tk_Height(tkwin);
/*
* Much of the redisplay is done totally differently for horizontal and
* vertical scales. Handle the part that's different.
*/
if (scalePtr->orient == ORIENT_VERTICAL) {
DisplayVerticalScale(scalePtr, pixmap, &drawnArea);
} else {
DisplayHorizontalScale(scalePtr, pixmap, &drawnArea);
}
/*
* Now handle the part of redisplay that is the same for horizontal and
* vertical scales: border and traversal highlight.
*/
if (scalePtr->flags & REDRAW_OTHER) {
if (scalePtr->relief != TK_RELIEF_FLAT) {
Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder,
scalePtr->highlightWidth, scalePtr->highlightWidth,
Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
scalePtr->borderWidth, scalePtr->relief);
}
if (scalePtr->highlightWidth != 0) {
GC gc;
if (scalePtr->flags & GOT_FOCUS) {
gc = Tk_GCForColor(scalePtr->highlightColorPtr, pixmap);
} else {
gc = Tk_GCForColor(
Tk_3DBorderColor(scalePtr->highlightBorder), pixmap);
}
Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, pixmap);
}
}
#ifndef TK_NO_DOUBLE_BUFFERING
/*
* Copy the information from the off-screen pixmap onto the screen, then
* delete the pixmap.
*/
XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin),
scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width,
drawnArea.height, drawnArea.x, drawnArea.y);
Tk_FreePixmap(scalePtr->display, pixmap);
#endif /* TK_NO_DOUBLE_BUFFERING */
done:
scalePtr->flags &= ~REDRAW_ALL;
}
/*ARGSUSED*/
static int
EmbWinLayoutProc(
TkText *textPtr, /* Text widget being layed out. */
TkTextIndex *indexPtr, /* Identifies first character in chunk. */
TkTextSegment *ewPtr, /* Segment corresponding to indexPtr. */
int offset, /* Offset within segPtr corresponding to
* indexPtr (always 0). */
int maxX, /* Chunk must not occupy pixels at this
* position or higher. */
int maxChars, /* Chunk must not include more than this many
* characters. */
int noCharsYet, /* Non-zero means no characters have been
* assigned to this line yet. */
TkWrapMode wrapMode, /* Wrap mode to use for line:
* TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, or
* TEXT_WRAPMODE_WORD. */
register TkTextDispChunk *chunkPtr)
/* Structure to fill in with information about
* this chunk. The x field has already been
* set by the caller. */
{
int width, height;
TkTextEmbWindowClient *client;
if (offset != 0) {
Tcl_Panic("Non-zero offset in EmbWinLayoutProc");
}
client = EmbWinGetClient(textPtr, ewPtr);
if (client == NULL) {
ewPtr->body.ew.tkwin = NULL;
} else {
ewPtr->body.ew.tkwin = client->tkwin;
}
if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) {
int code, isNew;
Tk_Window ancestor;
Tcl_HashEntry *hPtr;
const char *before, *string;
Tcl_DString name, buf, *dsPtr = NULL;
before = ewPtr->body.ew.create;
/*
* Find everything up to the next % character and append it to the
* result string.
*/
string = before;
while (*string != 0) {
if ((*string == '%') && (string[1] == '%' || string[1] == 'W')) {
if (dsPtr == NULL) {
Tcl_DStringInit(&buf);
dsPtr = &buf;
}
if (string != before) {
Tcl_DStringAppend(dsPtr, before, (int) (string-before));
before = string;
}
if (string[1] == '%') {
Tcl_DStringAppend(dsPtr, "%", 1);
} else {
/*
* Substitute string as proper Tcl list element.
*/
int spaceNeeded, cvtFlags, length;
const char *str = Tk_PathName(textPtr->tkwin);
spaceNeeded = Tcl_ScanElement(str, &cvtFlags);
length = Tcl_DStringLength(dsPtr);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
spaceNeeded = Tcl_ConvertElement(str,
Tcl_DStringValue(dsPtr) + length,
cvtFlags | TCL_DONT_USE_BRACES);
Tcl_DStringSetLength(dsPtr, length + spaceNeeded);
}
before += 2;
string++;
}
string++;
}
/*
* The window doesn't currently exist. Create it by evaluating the
* creation script. The script must return the window's path name:
* look up that name to get back to the window token. Then register
* ourselves as the geometry manager for the window.
*/
if (dsPtr != NULL) {
Tcl_DStringAppend(dsPtr, before, (int) (string-before));
code = Tcl_GlobalEval(textPtr->interp, Tcl_DStringValue(dsPtr));
Tcl_DStringFree(dsPtr);
} else {
code = Tcl_GlobalEval(textPtr->interp, ewPtr->body.ew.create);
}
if (code != TCL_OK) {
createError:
Tcl_BackgroundException(textPtr->interp, code);
goto gotWindow;
}
Tcl_DStringInit(&name);
Tcl_DStringAppend(&name, Tcl_GetStringResult(textPtr->interp), -1);
Tcl_ResetResult(textPtr->interp);
ewPtr->body.ew.tkwin = Tk_NameToWindow(textPtr->interp,
Tcl_DStringValue(&name), textPtr->tkwin);
Tcl_DStringFree(&name);
if (ewPtr->body.ew.tkwin == NULL) {
goto createError;
}
for (ancestor = textPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
break;
}
if (Tk_TopWinHierarchy(ancestor)) {
badMaster:
Tcl_AppendResult(textPtr->interp, "can't embed ",
Tk_PathName(ewPtr->body.ew.tkwin), " relative to ",
Tk_PathName(textPtr->tkwin), NULL);
Tcl_BackgroundError(textPtr->interp);
ewPtr->body.ew.tkwin = NULL;
goto gotWindow;
}
}
if (Tk_TopWinHierarchy(ewPtr->body.ew.tkwin)
|| (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
goto badMaster;
}
if (client == NULL) {
/*
* We just used a '-create' script to make a new window, which we
* now need to add to our client list.
*/
client = (TkTextEmbWindowClient *)
ckalloc(sizeof(TkTextEmbWindowClient));
client->next = ewPtr->body.ew.clients;
client->textPtr = textPtr;
client->tkwin = NULL;
client->chunkCount = 0;
client->displayed = 0;
client->parent = ewPtr;
ewPtr->body.ew.clients = client;
}
client->tkwin = ewPtr->body.ew.tkwin;
Tk_ManageGeometry(client->tkwin, &textGeomType, client);
Tk_CreateEventHandler(client->tkwin, StructureNotifyMask,
EmbWinStructureProc, client);
/*
* Special trick! Must enter into the hash table *after* calling
* Tk_ManageGeometry: if the window was already managed elsewhere in
* this text, the Tk_ManageGeometry call will cause the entry to be
* removed, which could potentially lose the new entry.
*/
hPtr = Tcl_CreateHashEntry(&textPtr->sharedTextPtr->windowTable,
Tk_PathName(client->tkwin), &isNew);
Tcl_SetHashValue(hPtr, ewPtr);
}
/*
* See if there's room for this window on this line.
*/
gotWindow:
if (ewPtr->body.ew.tkwin == NULL) {
width = 0;
height = 0;
} else {
width = Tk_ReqWidth(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padX;
height = Tk_ReqHeight(ewPtr->body.ew.tkwin) + 2*ewPtr->body.ew.padY;
}
if ((width > (maxX - chunkPtr->x))
&& !noCharsYet && (textPtr->wrapMode != TEXT_WRAPMODE_NONE)) {
return 0;
}
/*
* Fill in the chunk structure.
*/
chunkPtr->displayProc = TkTextEmbWinDisplayProc;
chunkPtr->undisplayProc = EmbWinUndisplayProc;
chunkPtr->measureProc = NULL;
chunkPtr->bboxProc = EmbWinBboxProc;
chunkPtr->numBytes = 1;
if (ewPtr->body.ew.align == ALIGN_BASELINE) {
chunkPtr->minAscent = height - ewPtr->body.ew.padY;
chunkPtr->minDescent = ewPtr->body.ew.padY;
chunkPtr->minHeight = 0;
} else {
chunkPtr->minAscent = 0;
chunkPtr->minDescent = 0;
chunkPtr->minHeight = height;
}
chunkPtr->width = width;
chunkPtr->breakIndex = -1;
chunkPtr->breakIndex = 1;
chunkPtr->clientData = ewPtr;
if (client != NULL) {
client->chunkCount += 1;
}
return 1;
}
static OSErr
PrintHandler(
const AppleEvent * event,
AppleEvent * reply,
SRefCon handlerRefcon)
{
Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
AEDescList fileSpecList;
FSRef file;
DescType type;
Size actual;
long count, index;
AEKeyword keyword;
Tcl_DString command, pathName;
Tcl_CmdInfo dummy;
int code;
/*
* Don't bother if we don't have an interp or the print document procedure
* doesn't exist.
*/
if (!interp ||
!Tcl_GetCommandInfo(interp, "::tk::mac::PrintDocument", &dummy)) {
return noErr;
}
/*
* If we get any errors while retrieving our parameters we just return with
* no error.
*/
if (ChkErr(AEGetParamDesc, event, keyDirectObject, typeAEList,
&fileSpecList) != noErr) {
return noErr;
}
if (ChkErr(MissedAnyParameters, event) != noErr) {
return noErr;
}
if (ChkErr(AECountItems, &fileSpecList, &count) != noErr) {
return noErr;
}
Tcl_DStringInit(&command);
Tcl_DStringAppend(&command, "::tk::mac::PrintDocument", -1);
for (index = 1; index <= count; index++) {
if (ChkErr(AEGetNthPtr, &fileSpecList, index, typeFSRef, &keyword,
&type, (Ptr) &file, sizeof(FSRef), &actual) != noErr) {
continue;
}
if (ChkErr(FSRefToDString, &file, &pathName) == noErr) {
Tcl_DStringAppendElement(&command, Tcl_DStringValue(&pathName));
Tcl_DStringFree(&pathName);
}
}
/*
* Now handle the event by evaluating a script.
*/
code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_BackgroundException(interp, code);
}
Tcl_DStringFree(&command);
return noErr;
}
void
TkMacOSXHandleMenuSelect(
MenuID theMenu,
MenuItemIndex theItem,
int optionKeyPressed)
{
Tk_Window tkwin;
Window window;
TkDisplay *dispPtr;
Tcl_CmdInfo dummy;
int code;
if (theItem == 0) {
TkMacOSXClearMenubarActive();
return;
}
switch (theMenu) {
case kAppleMenu:
switch (theItem) {
case kAppleAboutItem:
if (optionKeyPressed || gInterp == NULL ||
Tcl_GetCommandInfo(gInterp, "tkAboutDialog", &dummy) == 0) {
TkAboutDlg();
} else {
code = Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
TCL_EVAL_GLOBAL);
if (code != TCL_OK) {
Tcl_BackgroundException(gInterp, code);
}
Tcl_ResetResult(gInterp);
}
break;
}
break;
case kFileMenu:
switch (theItem) {
case kSourceItem:
if (gInterp) {
if (Tcl_EvalEx(gInterp, "tk_getOpenFile -filetypes {"
"{{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}",
-1, TCL_EVAL_GLOBAL) == TCL_OK) {
Tcl_Obj *path = Tcl_GetObjResult(gInterp);
int len;
Tcl_GetStringFromObj(path, &len);
if (len) {
Tcl_IncrRefCount(path);
code = Tcl_FSEvalFile(gInterp, path);
if (code != TCL_OK) {
Tcl_BackgroundException(gInterp, code);
}
Tcl_DecrRefCount(path);
}
}
Tcl_ResetResult(gInterp);
}
break;
case kDemoItem:
if (gInterp) {
Tcl_Obj *path = GetWidgetDemoPath(gInterp);
if (path) {
Tcl_IncrRefCount(path);
code = Tcl_FSEvalFile(gInterp, path);
if (code != TCL_OK) {
Tcl_BackgroundException(gInterp, code);
}
Tcl_DecrRefCount(path);
Tcl_ResetResult(gInterp);
}
}
break;
case kCloseItem:
/* Send close event */
window = TkMacOSXGetXWindow(ActiveNonFloatingWindow());
dispPtr = TkGetDisplayList();
tkwin = Tk_IdToWindow(dispPtr->display, window);
TkGenWMDestroyEvent(tkwin);
break;
}
break;
case kEditMenu:
/*
* This implementation just send the keysyms Tk thinks are associated
* with function keys that do Cut, Copy & Paste on a Sun keyboard.
*/
GenerateEditEvent(theItem);
break;
default:
TkMacOSXDispatchMenuEvent(theMenu, theItem);
break;
}
/*
* Finally we unhighlight the menu.
*/
HiliteMenu(0);
}
