This is Tk.m in view mode; [Download] [Up]
/* Implementation for Objective-C Tcl, Tk interpretter object
Copyright (C) 1993,1994 R. Andrew McCallum
Written by: R. Andrew McCallum <mccallum@cs.rochester.edu>
Dept. of Computer Science, U. of Rochester, Rochester, NY 14627
This file is part of the Tcl/Objective-C interface library.
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Library General Public License for more details.
You should have received a copy of the GNU Library General Public
License along with this library; if not, write to the Free
Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include "Tk.h"
#include <coll/Dictionary.h>
#include <readline/readline.h>
#include <readline/history.h>
#include <tk.h>
#include "tclObjc.h"
//#include <string.h>
// Global variables used by the main program:
static Tk_Window w; /* The main window for the application. If
* NULL then the application no longer
* exists. */
/* Used to assemble lines of terminal input
* into Tcl commands. */
/* static Tcl_DString command; */
// Forward declarations for procedures defined later in this file:
static void DelayedMap _ANSI_ARGS_((ClientData clientData));
static void StructureProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
int tk_iter()
{
if (tk_NumMainWindows <= 0) { rl_event_hook = 0; return 0; }
while (Tk_DoOneEvent(TK_ALL_EVENTS | TK_DONT_WAIT));
return 1;
}
static int synchronize = 0;
static char *display = NULL;
static char *name = NULL;
@implementation Tk
- (char *) preInitWithArgc: (int)argc argv: (char**)argv
{
char *fileName;
Tk_3DBorder border;
fileName = [super preInitWithArgc:argc argv:argv];
/*
* Initialize the Tk application and arrange to map the main window
* after the startup script has been executed, if any. This way
* the script can withdraw the window so it isn't ever mapped
* at all.
*/
if (argc)
name = argv[0];
else
name = "tkObjc";
w = Tk_CreateMainWindow(interp, display, name, "Tk");
if (w == NULL) {
fprintf(stderr, "%s\n", interp->result);
exit(1);
}
Tk_SetClass(w, "Tk");
Tk_CreateEventHandler(w, StructureNotifyMask, StructureProc,
(ClientData) NULL);
Tk_DoWhenIdle(DelayedMap, (ClientData) NULL);
if (synchronize) {
XSynchronize(Tk_Display(w), True);
}
Tk_GeometryRequest(w, 200, 200);
border = Tk_Get3DBorder(interp, w, None, "#ffe4c4");
if (border == NULL) {
Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
Tk_SetWindowBackground(w, WhitePixelOfScreen(Tk_Screen(w)));
} else {
Tk_SetBackgroundFromBorder(w, border);
}
XSetForeground(Tk_Display(w), DefaultGCOfScreen(Tk_Screen(w)),
BlackPixelOfScreen(Tk_Screen(w)));
return fileName;
}
- initWithArgc: (int)argc argv: (char**)argv
{
char *msg;
[super initWithArgc: argc argv: argv];
// tclObjc_eventHook = tk_iter;
rl_readline_name = argv[0];
rl_event_hook = tk_iter;
fflush(stdout);
(void) Tcl_Eval(interp, "update");
return self;
error:
msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
if (msg == NULL) {
msg = interp->result;
}
fprintf(stderr, "%s\n", msg);
Tcl_Eval(interp, "destroy .");
exit(1);
return nil;
}
- promptAndEval
{
Tcl_DString command;
char *cmd;
char *line;
int result;
int gotPartial = 0;
Tcl_DStringInit(&command);
while (tk_NumMainWindows > 0)
{
if (!gotPartial)
line = readline("wish: ");
else
line = readline("> ");
if (!line)
return self;
add_history(line);
cmd = Tcl_DStringAppend(&command, line, -1);
free(line);
if (!Tcl_CommandComplete(cmd))
{
gotPartial = 1;
continue;
}
gotPartial = 0;
result = Tcl_RecordAndEval(interp, cmd, 0);
Tcl_DStringFree(&command);
if (result != TCL_OK)
fprintf(stderr, "%s\n", interp->result);
else
printf("%s\n", interp->result);
}
return self;
}
- free
{
Tcl_GlobalEval(interp, "destroy .\n");
return [super free];
}
/*
*----------------------------------------------------------------------
*
* StructureProc --
*
* This procedure is invoked whenever a structure-related event
* occurs on the main window. If the window is deleted, the
* procedure modifies "w" to record that fact.
*
* Results:
* None.
*
* Side effects:
* Variable "w" may get set to NULL.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static void
StructureProc(clientData, eventPtr)
ClientData clientData; /* Information about window. */
XEvent *eventPtr; /* Information about event. */
{
if (eventPtr->type == DestroyNotify) {
w = NULL;
}
}
/*
*----------------------------------------------------------------------
*
* DelayedMap --
*
* This procedure is invoked by the event dispatcher once the
* startup script has been processed. It waits for all other
* pending idle handlers to be processed (so that all the
* geometry information will be correct), then maps the
* application's main window.
*
* Results:
* None.
*
* Side effects:
* The main window gets mapped.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
static void
DelayedMap(clientData)
ClientData clientData; /* Not used. */
{
while (Tk_DoOneEvent(TK_IDLE_EVENTS) != 0) {
/* Empty loop body. */
}
if (w == NULL) {
return;
}
Tk_MapWindow(w);
}
@end
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.