TclTextInterp.C

00001 /***************************************************************************
00002 *cr
00003 *cr (C) Copyright 1995-2019 The Board of Trustees of the
00004 *cr University of Illinois
00005 *cr All Rights Reserved
00006 *cr
00007 ***************************************************************************/
00008 
00009 /***************************************************************************
00010 * RCS INFORMATION:
00011 *
00012 * $RCSfile: TclTextInterp.C,v $
00013 * $Author: johns $ $Locker: $ $State: Exp $
00014 * $Revision: 1.136 $ $Date: 2020年07月08日 04:20:45 $
00015 *
00016 ***************************************************************************
00017 * DESCRIPTION:
00018 * The Tcl-based text command interpreter implementation
00019 ***************************************************************************/
00020 
00021 #include <tcl.h>
00022 #include <stdlib.h>
00023 #include <ctype.h> // for toupper/tolower
00024 
00025 #ifdef VMDTK
00026 #if defined(_MSC_VER)
00027 // XXX prototype, skip problems with tk.h.
00028 EXTERN int Tk_Init _ANSI_ARGS_((Tcl_Interp *interp));
00029 #else
00030 #include <tk.h> // Tk extensions
00031 #endif
00032 #endif
00033 
00034 #if defined(VMDLINENOISE)
00035 // linenoise is a minimalistic command line editor similar to 
00036 // GNU readline, but with a permissive BSD license, and just 
00037 // enough functionality to please most users. 
00038 // https://github.com/antirez/linenoise
00039 #include "linenoise.h"
00040 #endif
00041 
00042 #if defined(VMDTECLA)
00043 // tecla is a featureful interactive command line editing alternative 
00044 // to GNU readline, with a permissive X11 style license, and support
00045 // for fully non-blocking character-at-a-time terminal handling, 
00046 // with native support for externally driven event loops unlike many others.
00047 // https://www.astro.caltech.edu/~mcs/tecla/index.html
00048 #include <libtecla.h>
00049 #endif
00050 
00051 #include "TclTextInterp.h"
00052 #include "Inform.h"
00053 #include "TclCommands.h"
00054 #include "VMDApp.h"
00055 #include "DisplayDevice.h" 
00056 
00057 #include "config.h"
00058 #if defined(VMDTKCON)
00059 #include "vmdconsole.h"
00060 #endif
00061 
00062 #if !defined(_MSC_VER)
00063 #include <unistd.h>
00064 static int vmd_isatty(int fd) {
00065 // Check for console tty override in case we're running on a cluster node
00066 // on Clustermatic or Scyld, which cause isatty() to return false even when
00067 // we do have a tty. This makes it possible to get the normal VMD prompts
00068 // in an interactive bpsh session if we want.
00069 if (getenv("VMDFORCECONSOLETTY") != NULL)
00070 return 1;
00071 
00072 return isatty(fd);
00073 }
00074 
00075 #else
00076 static int vmd_isatty(int) {
00077 return 1;
00078 }
00079 #endif
00080 
00081 
00082 #if defined(VMDLINENOISE)
00083 void linenoise_completion_cb(void *uctx, const char *buf, linenoiseCompletions *lc) {
00084 if (uctx != NULL && buf != NULL && lc != NULL) {
00085 ResizeArray<char *> * completion_list = (ResizeArray<char *> *) uctx;
00086 int len = strlen(buf);
00087 int num = completion_list->num();
00088 for (int i=0; i<num; i++) {
00089 const char *compstr = (*completion_list)[i];
00090 if (!strncmp(buf, compstr, len)) {
00091 linenoiseAddCompletion(lc, compstr);
00092 }
00093 }
00094 }
00095 }
00096 #endif
00097 
00098 #if defined(VMDTECLA)
00099 int tecla_completion_cb(WordCompletion *cpl, void *uctx, const char *buf, int word_end) {
00100 if (cpl != NULL && uctx != NULL && buf != NULL) {
00101 ResizeArray<char *> * completion_list = (ResizeArray<char *> *) uctx;
00102 int i, word_start;
00103 
00104 // find beginning of incomplete command word by looking for whitespace
00105 word_start=word_end;
00106 for (i=word_end; i>=0; i--) {
00107 word_start=i;
00108 if (buf[i] == ' ')
00109 break;
00110 }
00111 
00112 int len = word_end - word_start;
00113 int num = completion_list->num();
00114 if (len > 0) {
00115 for (i=0; i<num; i++) {
00116 const char *cstr = (*completion_list)[i];
00117 if (!strncmp(buf+word_start, cstr, len)) {
00118 cpl_add_completion(cpl, buf, len, word_end, cstr+word_end, "", " ");
00119 }
00120 }
00121 }
00122 }
00123 return 0;
00124 }
00125 #endif
00126 
00127 static int text_cmd_wait(ClientData cd, Tcl_Interp *interp, int argc,
00128 const char *argv[]) {
00129 TclTextInterp *ttinterp = (TclTextInterp *)cd;
00130 if(argc == 2) {
00131 ttinterp->wait((float)atof(argv[1]));
00132 } else {
00133 Tcl_AppendResult(interp, "wait: Usage: wait <seconds>",NULL);
00134 return TCL_ERROR;
00135 }
00136 return TCL_OK;
00137 }
00138 
00139 
00140 static int text_cmd_quit(ClientData cd, Tcl_Interp *interp, int argc,
00141 const char *argv[]) {
00142 VMDApp *app = (VMDApp *)cd;
00143 // Trigger exit seq on next display update. 
00144 // Avoid calling VMDexit more than once.
00145 if (!app->exitFlag) app->VMDexit("",0,0);
00146 
00147 // return TCL_ERROR so that execution of procs or sourcing of files
00148 // stops here as well.
00149 return TCL_ERROR;
00150 }
00151 
00152 
00153 static int text_cmd_play(ClientData cd, Tcl_Interp *interp, int argc,
00154 const char *argv[]) {
00155 TclTextInterp *ttinterp = (TclTextInterp *)cd;
00156 if (argc != 2) {
00157 Tcl_AppendResult(interp, "Usage: play <filename>", NULL);
00158 return TCL_ERROR;
00159 }
00160 if (ttinterp->evalFile(argv[1])) return TCL_ERROR;
00161 return TCL_OK;
00162 }
00163 
00164 
00165 TclTextInterp::TclTextInterp(VMDApp *vmdapp, int guienabled, int mpienabled)
00166 : app(vmdapp) {
00167 interp = Tcl_CreateInterp();
00168 #if 0
00169 Tcl_InitMemory(interp); // enable Tcl memory debugging features
00170 // when compiled with TCL_MEM_DEBUG
00171 #endif
00172 
00173 commandPtr = Tcl_NewObj();
00174 Tcl_IncrRefCount(commandPtr);
00175 consoleisatty = vmd_isatty(0); // whether we're interactive or not
00176 ignorestdin = 0;
00177 gotPartial = 0;
00178 needPrompt = 1;
00179 callLevel = 0;
00180 starttime = delay = 0;
00181 uselinenoise = 0;
00182 usetecla = 0;
00183 #if defined(VMDTECLA)
00184 tecla_gl = NULL;
00185 #endif
00186 
00187 #if defined(VMDMPI)
00188 //
00189 // MPI builds of VMD cannot try to read any command input from the 
00190 // console because it creates shutdown problems, at least with MPICH.
00191 // File-based command input is fine however.
00192 //
00193 // don't check for interactive console input if running in parallel
00194 if (mpienabled)
00195 ignorestdin = 1;
00196 #endif
00197 
00198 #if defined(ANDROIDARMV7A)
00199 //
00200 // For the time being, the Android builds won't attempt to get any
00201 // console input. Any input we're going to get is going to come via
00202 // some means other than stdin, such as a network socket, text box, etc.
00203 //
00204 // Don't check for interactive console input if compiled for Android
00205 ignorestdin = 1;
00206 #endif
00207 
00208 // set tcl_interactive, lets us run unix commands as from a shell
00209 #if !defined(VMD_NANOHUB)
00210 Tcl_SetVar(interp, "tcl_interactive", "1", 0);
00211 #else
00212 Tcl_SetVar(interp, "tcl_interactive", "0", 0);
00213 
00214 Tcl_Channel channel;
00215 #define CLIENT_READ (3)
00216 #define CLIENT_WRITE (4)
00217 channel = Tcl_MakeFileChannel((ClientData)CLIENT_READ, TCL_READABLE);
00218 if (channel != NULL) {
00219 const char *result;
00220 
00221 Tcl_RegisterChannel(interp, channel);
00222 result = Tcl_SetVar2(interp, "vmd_client", "read", 
00223 Tcl_GetChannelName(channel), 
00224 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00225 if (result == NULL) {
00226 fprintf(stderr, "can't create variable for client read channel\n");
00227 }
00228 }
00229 channel = Tcl_MakeFileChannel((ClientData)CLIENT_WRITE, TCL_WRITABLE);
00230 if (channel != NULL) {
00231 const char *result;
00232 
00233 Tcl_RegisterChannel(interp, channel);
00234 result = Tcl_SetVar2(interp, "vmd_client", "write", 
00235 Tcl_GetChannelName(channel), 
00236 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00237 if (result == NULL) {
00238 fprintf(stderr, "can't create variable for client write channel\n");
00239 }
00240 }
00241 write(CLIENT_WRITE, "vmd 1.0\n", 8);
00242 #endif
00243 
00244 // pass our instance of VMDApp to a hash table assoc. with the interpreter 
00245 Tcl_SetAssocData(interp, "VMDApp", NULL, app);
00246 
00247 // Set up argc, argv0, and argv variables
00248 {
00249 char argcbuf[20];
00250 sprintf(argcbuf, "%d", app->argc_m);
00251 Tcl_SetVar(interp, "argc", argcbuf, TCL_GLOBAL_ONLY);
00252 // it might be better to use the same thing that was passed to
00253 // Tcl_FindExecutable, but this is now
00254 Tcl_SetVar(interp, "argv0", app->argv_m[0], TCL_GLOBAL_ONLY);
00255 char *args = Tcl_Merge(app->argc_m-1, app->argv_m+1);
00256 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
00257 Tcl_Free(args);
00258 }
00259 
00260 #if defined(_MSC_VER)
00261 // The Windows versions of Tcl 8.5.x have trouble finding
00262 // the Tcl library subdirectory for unknown reasons.
00263 // We force the appropriate env variables to be set in Tcl, 
00264 // despite Windows.
00265 {
00266 char vmdinitscript[4096] = { 0 };
00267 char * tcl_library = getenv("TCL_LIBRARY");
00268 char * tk_library = getenv("TK_LIBRARY");
00269 
00270 if (tcl_library) {
00271 sprintf(vmdinitscript, "set env(TCL_LIBRARY) {%s}", tcl_library);
00272 if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00273 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00274 }
00275 }
00276 if (tk_library) {
00277 sprintf(vmdinitscript, "set env(TK_LIBRARY) {%s}", tk_library);
00278 if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00279 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00280 }
00281 }
00282 }
00283 #endif
00284 
00285 if (Tcl_Init(interp) == TCL_ERROR) { // new with 7.6
00286 msgErr << "Tcl startup error: " << Tcl_GetStringResult(interp) << sendmsg;
00287 }
00288 
00289 #ifdef VMDTK
00290 // XXX Notes on Tcl/Tk support for high-DPI displays:
00291 // General cross-platform Tcl/Tk issues for high-DPI 
00292 // Tk 8.7 will do far more with high-DPI support than prior versions
00293 // and support a subset of SVG vector graphics (not text or filters).
00294 // The "tk scaling" command will set/return widget scaling factor
00295 // Use Ttk widgets rather than base widgets since they scale better.
00296 // Use point sizes rather than pixels in GUI layout math.
00297 // https://groups.google.com/forum/#!msg/comp.lang.tcl/Ig644HwsmN0/c5Nkvd0tBAAJ
00298 // MS Windows didn't provide per-screen scaling data until >= Windows 8.1
00299 // Windows 10 has a compatibility properties option for display scaling:
00300 // https://www.perlmonks.org/?node_id=1176356
00301 //
00302 // Win32/Win64 high-DPI initialization APIs:
00303 // https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-setprocessdpiaware
00304 // Application sets itself in high-DPI mode before GUI bringup:
00305 // #include <winuser.h>
00306 // SetProcessDPIAware();
00307 // 
00308 // Enabling MacOS X retina mode in Info.plist is done by adding a key: 
00309 // https://developer.apple.com/documentation/bundleresources/information_property_list/nshighresolutioncapable
00310 // <key>NSHighResolutionCapable</key>
00311 // <true/>
00312 // or:
00313 // <key>NSPrincipalClass</key>
00314 // <string>NSApplication</string>
00315 // <key>NSHighResolutionCapable</key>
00316 // <string>True</string>
00317 // Adding the NSHighResolutionCapable key to Info.plist will automatically
00318 // set GUI widget scaling to 2x for retina displays for GUIs written
00319 // using Cocoa. Apps using Carbon retain 1x scaling (they ignore this).
00320 // Some previous discussions and tips:
00321 // https://sites.google.com/a/mikelpr.com/retinizer/
00322 // https://bugs.python.org/issue15587
00323 // https://superuser.com/questions/620824/is-it-possible-to-have-git-gui-gitk-look-good-on-a-retina-macbook-pro
00324 // https://www.codebykevin.com/blosxom.cgi/2013
00325 //
00326 // and the Tk commands (but only if a GUI is available!)
00327 if (guienabled) {
00328 if (Tk_Init(interp) == TCL_ERROR) {
00329 msgErr << "Tk startup error: " << Tcl_GetStringResult(interp) << sendmsg;
00330 } else {
00331 Tcl_StaticPackage(interp, "Tk",
00332 (Tcl_PackageInitProc *) Tk_Init,
00333 (Tcl_PackageInitProc *) NULL);
00334 }
00335 } // end of check that GUI is allowed
00336 #endif
00337 
00338 add_commands(); // create top level VMD Tcl commands
00339 
00340 update_completion_list(); // update line editor command completion list
00341 
00342 if (consoleisatty) {
00343 if (getenv("VMDRLWRAPINUSE") != NULL) {
00344 msgInfo << "Internal command editing disabled, external rlwrap in use." << sendmsg;
00345 } else {
00346 
00347 #if defined(VMDTECLA)
00348 if (!getenv("VMDNOTECLA")) { 
00349 usetecla = 1;
00350 uselinenoise = 0;
00351 
00352 tecla_gl = new_GetLine(1024, 2048);
00353 if (tecla_gl == NULL) {
00354 usetecla = 0;
00355 goto fatal;
00356 }
00357 
00358 // register VMD command completion callback, otherwise tecla
00359 // will respond to the tab completion event by listing available
00360 // filenames, which is also potentially useful, but not what
00361 // users will have grown accustomed to...
00362 gl_customize_completion(tecla_gl, &completion_list, tecla_completion_cb);
00363 
00364 msgInfo << "Internal command editing enabled (tecla)." << sendmsg;
00365 } else {
00366 msgInfo << "Internal command editing disabled by user request." << sendmsg;
00367 }
00368 fatal:;
00369 #endif
00370 
00371 #if defined(VMDLINENOISE)
00372 if (!usetecla) {
00373 if (!getenv("VMDNOLINENOISE")) { 
00374 uselinenoise = 1;
00375 
00376 // set maximum command history when compiled with linenoise support
00377 linenoiseHistorySetMaxLen(100);
00378 linenoiseSetCompletionCallback(&completion_list, linenoise_completion_cb);
00379 
00380 msgInfo << "Internal command editing enabled (linenoise)." << sendmsg;
00381 } else {
00382 msgInfo << "Internal command editing disabled by user request." << sendmsg;
00383 }
00384 }
00385 #endif
00386 
00387 } // external rlwrap is not in use
00388 } // consoleisatty
00389 }
00390 
00391 
00392 void TclTextInterp::add_commands() {
00393 Vmd_Init(interp);
00394 
00395 Atomsel_Init(interp);
00396 
00397 Tcl_CreateCommand(interp, "molinfo", molecule_tcl,
00398 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00399 
00400 Tcl_CreateCommand(interp, "graphics", graphics_tcl,
00401 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00402 
00403 Tcl_CreateCommand(interp, "colorinfo", tcl_colorinfo,
00404 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00405 
00406 Tcl_CreateCommand(interp, "wait", text_cmd_wait,
00407 (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00408 
00409 Tcl_CreateCommand(interp, "play", text_cmd_play,
00410 (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00411 
00412 Tcl_CreateCommand(interp, "exit", text_cmd_quit,
00413 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00414 
00415 Tcl_CreateCommand(interp, "quit", text_cmd_quit,
00416 (ClientData) app, (Tcl_CmdDeleteProc *) NULL);
00417 
00418 Vec_Init(interp);
00419 }
00420 
00421 
00422 //
00423 // auto-generate a list of Tcl command completion strings for
00424 // interactive line editors with tab completion.
00425 //
00426 int TclTextInterp::update_completion_list() {
00427 int i;
00428 int num=completion_list.num();
00429 for (i=0; i<num; i++) {
00430 delete [] completion_list[i];
00431 }
00432 completion_list.clear(); // eliminate previous list
00433 num=0;
00434 
00435 // Generate the list of commands that we would expect a user to 
00436 // type in the text console, exluding one-time GUI registration procs
00437 // or other special commands that ought not be matched.
00438 const char *cmd_gen_completion_list =
00439 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION <= 5
00440 "proc lmap {_var list body} { \n"
00441 " upvar 1 $_var var \n"
00442 " set res {} \n"
00443 " foreach var $list {lappend res [uplevel 1 $body]} \n"
00444 " set res \n"
00445 "} \n"
00446 #endif
00447 
00448 "lsort [lmap x [info commands] { expr { [string match \"*_tk_cb\" $x] ? [continue] : $x }}]";
00449 if (Tcl_Eval(interp, cmd_gen_completion_list) != TCL_OK) {
00450 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00451 return 0;
00452 } else {
00453 Tcl_Obj *resultobj = Tcl_GetObjResult(interp);
00454 Tcl_Obj **cmdlist=NULL;
00455 if (Tcl_ListObjGetElements(interp, resultobj, &num, &cmdlist) != TCL_OK) {
00456 return 0;
00457 }
00458 
00459 completion_list.extend(num);
00460 for (i=0; i<num; i++) {
00461 completion_list.append(stringdup(Tcl_GetStringFromObj(cmdlist[i], NULL)));
00462 }
00463 }
00464 
00465 return num;
00466 }
00467 
00468 
00469 void TclTextInterp::doInit() {
00470 int startuperror = 0;
00471 const char *vmddir;
00472 char vmdinitscript[4096] = { 0 };
00473 
00474 vmddir = getenv("VMDDIR"); 
00475 
00476 // read the VMD initialization script
00477 if (vmddir == NULL) {
00478 msgErr << "VMDDIR undefined, startup failure likely." << sendmsg;
00479 #if defined(_MSC_VER)
00480 vmddir = "c:/program files/university of illinois/vmd";
00481 #else
00482 vmddir = "/usr/local/lib/vmd";
00483 #endif
00484 startuperror = 1;
00485 } 
00486 
00487 // force VMDDIR env variable to be set in Tcl, despite Windows.
00488 sprintf(vmdinitscript, "set env(VMDDIR) {%s}", vmddir);
00489 if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00490 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00491 startuperror = 1;
00492 }
00493 
00494 sprintf(vmdinitscript, "source {%s/scripts/vmd/vmdinit.tcl}", vmddir);
00495 if (Tcl_Eval(interp, vmdinitscript) != TCL_OK) {
00496 startuperror = 1;
00497 }
00498 
00499 if (startuperror) {
00500 msgErr << "Could not read the vmd initialization file -" << sendmsg;
00501 msgErr << " " << vmdinitscript << sendmsg;
00502 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00503 
00504 #if defined(_MSC_VER)
00505 msgErr << "The VMDDIR variable in the Windows registry is missing or" 
00506 << " incorrect. " << sendmsg;
00507 #else
00508 msgErr << "The VMDDIR environment variable is set by the startup"
00509 << sendmsg;
00510 msgErr << "script and should point to the top of the VMD hierarchy." 
00511 << sendmsg;
00512 #endif
00513 msgErr << "VMD will continue with limited functionality." << sendmsg;
00514 }
00515 
00516 update_completion_list(); // update line editor command completion list
00517 }
00518 
00519 
00520 TclTextInterp::~TclTextInterp() {
00521 // Set callback variable, giving a chance for Tcl to do some clean-ups
00522 // (for example, if external jobs have been run and need to be halted...)
00523 setString("vmd_quit", "1");
00524 
00525 // DeleteInterp must precede Finalize!
00526 Tcl_DeleteInterp(interp);
00527 interp = NULL; // prevent use by Python if Tcl_Finalize() invokes
00528 // shutdown scripts
00529 
00530 int num=completion_list.num();
00531 for (int i=0; i<num; i++) {
00532 delete [] completion_list[i];
00533 }
00534 
00535 #if defined(VMDTECLA)
00536 tecla_gl = del_GetLine(tecla_gl);
00537 #endif
00538 }
00539 
00540 
00541 int TclTextInterp::doTkUpdate() {
00542 // Loop on the Tcl event notifier
00543 while (Tcl_DoOneEvent(TCL_DONT_WAIT));
00544 return 1; 
00545 } 
00546 
00547 
00548 void TclTextInterp::doEvent() {
00549 int length = 0; // incoming command string length
00550 
00551 if (!done_waiting())
00552 return;
00553 
00554 // no recursive calls to TclEvalObj; this prevents 
00555 // display update ui from messing up Tcl. 
00556 if (callLevel) 
00557 return;
00558 
00559 Tcl_Channel inChannel = Tcl_GetStdChannel(TCL_STDIN);
00560 Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);
00561 
00562 if (!usetecla && needPrompt && consoleisatty) {
00563 if (gotPartial) {
00564 Tcl_WriteChars(outChannel, "? ", -1);
00565 } else { 
00566 Tcl_WriteChars(outChannel, VMD_CMD_PROMPT, -1);
00567 }
00568 #if defined(VMDTKCON)
00569 vmdcon_purge();
00570 #endif
00571 Tcl_Flush(outChannel);
00572 needPrompt = 0;
00573 }
00574 
00575 #if defined(VMD_NANOHUB) 
00576 return;
00577 #endif
00578 
00579 //
00580 // MPI builds of VMD cannot try to read any command input from the 
00581 // console because it creates shutdown problems, at least with MPICH.
00582 // File-based command input is fine however.
00583 //
00584 // For the time being, the Android builds won't attempt to get any
00585 // console input. Any input we're going to get is going to come via
00586 // some means other than stdin, such as a network socket, text box, etc.
00587 //
00588 if (ignorestdin)
00589 return;
00590 
00591 if (!usetecla && !uselinenoise && !vmd_check_stdin())
00592 return;
00593 
00594 #if defined(VMDLINENOISE)
00595 if (uselinenoise) {
00596 enableRawMode(STDIN_FILENO, 0);
00597 if (!vmd_check_stdin()) {
00598 disableRawMode(STDIN_FILENO, 0);
00599 return;
00600 }
00601 disableRawMode(STDIN_FILENO, 0);
00602 
00603 printf("\r"); fflush(stdout);
00604 char *tmpline=NULL;
00605 if ((tmpline = linenoise(VMD_CMD_PROMPT)) != NULL) {
00606 if (tmpline[0] != '0円') {
00607 length = strlen(tmpline);
00608 Tcl_AppendToObj(commandPtr, tmpline, length);
00609 Tcl_AppendToObj(commandPtr, "\n", 1);
00610 needPrompt = 1;
00611 }
00612 
00613 linenoiseFree(tmpline);
00614 }
00615 
00616 printf("\r"); fflush(stdout);
00617 }
00618 #endif
00619 
00620 #if defined(VMDTECLA)
00621 if (usetecla) {
00622 char *tmpline=NULL;
00623 if ((tmpline = gl_get_line(tecla_gl, VMD_CMD_PROMPT, NULL, -1)) != NULL) {
00624 if (tmpline[0] != '0円') {
00625 length = strlen(tmpline);
00626 Tcl_AppendToObj(commandPtr, tmpline, length);
00627 // Tcl_AppendToObj(commandPtr, "\n", 1);
00628 needPrompt = 1;
00629 }
00630 
00631 }
00632 }
00633 #endif
00634 
00635 //
00636 // event loop based on tclMain.c
00637 //
00638 // According to the Tcl docs, GetsObj returns -1 on error or EOF.
00639 if (!uselinenoise && !usetecla) {
00640 length = Tcl_GetsObj(inChannel, commandPtr);
00641 if (length < 0) {
00642 if (Tcl_Eof(inChannel)) {
00643 // exit if we're not a tty, or if eofexit is set
00644 if ((!consoleisatty) || app->get_eofexit())
00645 app->VMDexit("", 0, 0);
00646 } else {
00647 msgErr << "Error reading Tcl input: " << Tcl_ErrnoMsg(Tcl_GetErrno()) 
00648 << sendmsg;
00649 }
00650 return;
00651 }
00652 
00653 needPrompt = 1;
00654 // add the newline removed by Tcl_GetsObj
00655 Tcl_AppendToObj(commandPtr, "\n", 1);
00656 }
00657 
00658 char *stringrep = Tcl_GetStringFromObj(commandPtr, NULL);
00659 if (!Tcl_CommandComplete(stringrep)) {
00660 gotPartial = 1;
00661 return;
00662 }
00663 gotPartial = 0;
00664 
00665 #if defined(VMDLINENOISE)
00666 if (uselinenoise) {
00667 char *ltmp = strdup(stringrep);
00668 int len = strlen(stringrep); 
00669 ltmp[len-1] = '0円'; // strip trailing newline
00670 linenoiseHistoryAdd(ltmp);
00671 free(ltmp);
00672 }
00673 #endif
00674 
00675 callLevel++;
00676 #if defined(VMD_NANOHUB)
00677 Tcl_EvalObjEx(interp, commandPtr, 0);
00678 #else
00679 Tcl_RecordAndEvalObj(interp, commandPtr, 0);
00680 #endif
00681 callLevel--;
00682 
00683 #if 1
00684 Tcl_DecrRefCount(commandPtr);
00685 commandPtr = Tcl_NewObj();
00686 Tcl_IncrRefCount(commandPtr);
00687 #else
00688 // XXX this crashes Tcl 8.5.[46] with an internal panic
00689 Tcl_SetObjLength(commandPtr, 0);
00690 #endif
00691 
00692 // if ok, send to stdout; if not, send to stderr
00693 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
00694 char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
00695 #if defined(VMDTKCON)
00696 if (length > 0) {
00697 vmdcon_append(VMDCON_ALWAYS, bytes,length);
00698 vmdcon_append(VMDCON_ALWAYS, "\n", 1);
00699 }
00700 vmdcon_purge();
00701 #else
00702 if (length > 0) {
00703 Tcl_WriteChars(outChannel, bytes, length);
00704 Tcl_WriteChars(outChannel, "\n", 1);
00705 }
00706 Tcl_Flush(outChannel);
00707 #endif
00708 }
00709 
00710 
00711 int TclTextInterp::evalString(const char *s) {
00712 #if defined(VMD_NANOHUB)
00713 // don't include cmd in history...
00714 if (Tcl_Eval(interp, s) != TCL_OK) {
00715 #else
00716 // record cmd into cmd history...
00717 if (Tcl_RecordAndEval(interp, s, 0) != TCL_OK) {
00718 #endif
00719 // Don't print error message if there's nothing to show.
00720 if (strlen(Tcl_GetStringResult(interp))) 
00721 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00722 return FALSE;
00723 }
00724 return TRUE;
00725 }
00726 
00727 
00728 void TclTextInterp::setString(const char *name, const char *val) {
00729 if (interp)
00730 Tcl_SetVar(interp, name, val, 
00731 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00732 }
00733 
00734 
00735 void TclTextInterp::setMap(const char *name, const char *key, 
00736 const char *val) { 
00737 if (interp)
00738 Tcl_SetVar2(interp, name, key, val, 
00739 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00740 }
00741 
00742 
00743 // There's a fair amount of code duplication between doEvent and evalFile,
00744 // maybe these could be combined somehow, say by having TclTextInterp keep 
00745 // track of its Tcl_Channel objects.
00746 // 
00747 // Side note: Reading line-by-line gives different Tcl semantics than 
00748 // just calling Tcl_EvalFile. Shell commands (e.g., stty) are properly
00749 // parsed when read line-by-line and passed to Tcl_RecordAndEval, but are
00750 // unrecognized when contained in a file read by Tcl_EvalFile. I would 
00751 // consider this a bug. 
00752 int TclTextInterp::evalFile(const char *fname) {
00753 Tcl_Channel inchannel = Tcl_OpenFileChannel(interp, fname, "r", 0644);
00754 Tcl_Channel outchannel = Tcl_GetStdChannel(TCL_STDOUT);
00755 if (inchannel == NULL) {
00756 msgErr << "Error opening file " << fname << sendmsg;
00757 msgErr << Tcl_GetStringResult(interp) << sendmsg;
00758 return 1;
00759 }
00760 
00761 Tcl_Obj *cmdPtr = Tcl_NewObj();
00762 Tcl_IncrRefCount(cmdPtr);
00763 int length = 0;
00764 while ((length = Tcl_GetsObj(inchannel, cmdPtr)) >= 0) {
00765 Tcl_AppendToObj(cmdPtr, "\n", 1);
00766 char *stringrep = Tcl_GetStringFromObj(cmdPtr, NULL);
00767 if (!Tcl_CommandComplete(stringrep)) {
00768 continue;
00769 }
00770 
00771 // check if "exit" was called
00772 if (app->exitFlag) break;
00773 
00774 #if defined(VMD_NANOHUB)
00775 Tcl_EvalObjEx(interp, cmdPtr, 0); // don't record cmd in history...
00776 #else
00777 Tcl_RecordAndEvalObj(interp, cmdPtr, 0); // record cmd into history...
00778 #endif
00779 
00780 #if 1
00781 Tcl_DecrRefCount(cmdPtr);
00782 cmdPtr = Tcl_NewObj();
00783 Tcl_IncrRefCount(cmdPtr);
00784 #else
00785 // XXX this crashes Tcl 8.5.[46] with an internal panic
00786 Tcl_SetObjLength(cmdPtr, 0);
00787 #endif
00788 
00789 // XXX this makes sure the display is updated 
00790 // after each line read from the file or pipe
00791 // So, this is also where we'd optimise reading multiple
00792 // lines at once
00793 //
00794 // In VR modes (CAVE, FreeVR, VR Juggler) the draw method will 
00795 // not be called from app->display_update(), so multiple lines
00796 // of input could be combined in one frame, if possible
00797 app->display_update();
00798 
00799 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
00800 char *bytes = Tcl_GetStringFromObj(resultPtr, &length);
00801 #if defined(VMDTKCON)
00802 if (length > 0) {
00803 vmdcon_append(VMDCON_ALWAYS, bytes,length);
00804 vmdcon_append(VMDCON_ALWAYS, "\n", 1);
00805 }
00806 vmdcon_purge();
00807 #else
00808 if (length > 0) {
00809 Tcl_WriteChars(outchannel, bytes, length);
00810 Tcl_WriteChars(outchannel, "\n", 1);
00811 }
00812 Tcl_Flush(outchannel);
00813 #endif
00814 }
00815 Tcl_Close(interp, inchannel);
00816 Tcl_DecrRefCount(cmdPtr);
00817 return 0;
00818 }
00819 
00820 void TclTextInterp::wait(float wd) {
00821 delay = wd;
00822 starttime = time_of_day();
00823 }
00824 int TclTextInterp::done_waiting() {
00825 if (delay > 0) {
00826 double elapsed = time_of_day() - starttime;
00827 if (elapsed > delay) {
00828 delay = -1; // done waiting
00829 } else {
00830 return 0; // not done yet
00831 }
00832 }
00833 return 1; // done
00834 }
00835 
00836 
00837 void TclTextInterp::frame_cb(int molid, int frame) {
00838 Tcl_ObjSetVar2(interp, Tcl_NewStringObj("vmd_frame", -1),
00839 Tcl_NewIntObj(molid),
00840 Tcl_NewIntObj(frame),
00841 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00842 }
00843 
00844 
00845 void TclTextInterp::help_cb(const char *topic) {
00846 JString cmd("help ");
00847 cmd += topic;
00848 evalString((const char *)cmd);
00849 }
00850 
00851 
00852 void TclTextInterp::molecule_changed_cb(int molid, int code) {
00853 char molstr[30];
00854 sprintf(molstr, "%d", molid);
00855 char codestr[30];
00856 sprintf(codestr, "%d", code);
00857 setMap("vmd_molecule", molstr, codestr);
00858 }
00859 
00860 
00861 void TclTextInterp::initialize_structure_cb(int molid, int code) {
00862 char molstr[30];
00863 sprintf(molstr, "%d", molid);
00864 char codestr[30];
00865 sprintf(codestr, "%d", code);
00866 setMap("vmd_initialize_structure", molstr, codestr);
00867 }
00868 
00869 
00870 void TclTextInterp::logfile_cb(const char *str) {
00871 setString("vmd_logfile", (const char *)str);
00872 }
00873 
00874 
00875 void TclTextInterp::pick_atom_cb(int molid, int atom, int ss, bool is_pick) {
00876 char s[40];
00877 sprintf(s, "%d",ss);
00878 setString("vmd_pick_shift_state", s);
00879 sprintf(s, "%d", molid);
00880 setString("vmd_pick_mol", s);
00881 sprintf(s, "%d", atom);
00882 setString("vmd_pick_atom", s);
00883 
00884 // only set this callback variable for a user pick event
00885 if (is_pick)
00886 setString("vmd_pick_event", "1");
00887 }
00888 
00889 
00890 void TclTextInterp::pick_atom_callback_cb(int molid, int atom, const char *client) {
00891 char s[40];
00892 sprintf(s, "%s", (const char *)client);
00893 setString("vmd_pick_client", s);
00894 sprintf(s, "%d", molid);
00895 setString("vmd_pick_mol_silent", s);
00896 sprintf(s, "%d", atom);
00897 setString("vmd_pick_atom_silent", s);
00898 } 
00899 
00900 
00901 void TclTextInterp::pick_graphics_cb(int molid, int tag, int btn, int shift_state) {
00902 char s[300];
00903 sprintf(s, "%d %d %d %d", molid, tag, btn, shift_state);
00904 setString("vmd_pick_graphics", s);
00905 }
00906 
00907 
00908 void TclTextInterp::pick_selection_cb(int num, const int *atoms) {
00909 JString s;
00910 if (num > 0) {
00911 s = "index";
00912 for (int i=0; i<num; i++) {
00913 char buf[20];
00914 sprintf(buf, " %d", atoms[i]);
00915 s += buf;
00916 }
00917 } else {
00918 s = "none";
00919 }
00920 setString("vmd_pick_selection", (const char *)s);
00921 }
00922 
00923 
00924 void TclTextInterp::pick_value_cb(float value) {
00925 char buf[20];
00926 sprintf(buf, "%f", value);
00927 setString("vmd_pick_value", buf);
00928 }
00929 
00930 
00931 void TclTextInterp::timestep_cb(int molid, int frame) {
00932 char mol[10];
00933 char n[10];
00934 sprintf(mol, "%d", molid);
00935 sprintf(n, "%d", frame);
00936 setMap("vmd_timestep", mol, n);
00937 }
00938 
00939 
00940 void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) {
00941 Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL);
00942 for (int i=0; i<n; i++) {
00943 Tcl_Obj *item = Tcl_NewListObj(0, NULL);
00944 Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1));
00945 Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i]));
00946 Tcl_ListObjAppendElement(interp, itemlist, item);
00947 }
00948 Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1);
00949 if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, 
00950 TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) {
00951 msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg;
00952 }
00953 }
00954 
00955 
00956 void TclTextInterp::trajectory_cb(int molid, const char *name) {
00957 char s[10];
00958 if (!name) return;
00959 sprintf(s, "%d", molid);
00960 setMap("vmd_trajectory_read", s, name);
00961 }
00962 
00963 
00964 void TclTextInterp::tcl_cb(const char *cmd) {
00965 evalString(cmd);
00966 }
00967 
00968 
00969 void TclTextInterp::mousemode_cb(const char *mode, int submode) {
00970 char tmp[20];
00971 sprintf(tmp, "%d", submode);
00972 setString("vmd_mouse_mode", (const char *)mode);
00973 setString("vmd_mouse_submode", tmp);
00974 }
00975 
00976 
00977 void TclTextInterp::mouse_pos_cb(float x, float y, int buttondown) {
00978 Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
00979 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(x));
00980 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(y));
00981 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
00982 Tcl_Obj *varname = Tcl_NewStringObj("vmd_mouse_pos", -1);
00983 Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
00984 }
00985 
00986 
00987 void TclTextInterp::mobile_state_changed_cb() {
00988 setString("vmd_mobile_state_changed", "1");
00989 }
00990 
00991 
00992 void TclTextInterp::mobile_device_command_cb(const char *str) {
00993 setString("vmd_mobile_device_command", (const char *)str);
00994 }
00995 
00996 
00997 void TclTextInterp::mobile_cb(float tx, float ty, float tz,
00998 float rx, float ry, float rz, int buttondown) {
00999 Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
01000 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tx));
01001 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ty));
01002 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tz));
01003 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rx));
01004 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ry));
01005 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rz));
01006 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
01007 Tcl_Obj *varname = Tcl_NewStringObj("vmd_mobile", -1);
01008 Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
01009 }
01010 
01011 
01012 void TclTextInterp::spaceball_cb(float tx, float ty, float tz,
01013 float rx, float ry, float rz, int buttondown) {
01014 Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
01015 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tx));
01016 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ty));
01017 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(tz));
01018 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rx));
01019 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(ry));
01020 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(rz));
01021 Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
01022 Tcl_Obj *varname = Tcl_NewStringObj("vmd_spaceball", -1);
01023 Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
01024 }
01025 
01026 
01027 void TclTextInterp::userkey_cb(const char *key_desc) {
01028 int indx = app->userKeys.typecode(key_desc);
01029 if(indx >= 0) {
01030 const char *cmd = app->userKeys.data(indx);
01031 evalString(cmd);
01032 }
01033 }
01034