Main Page   Namespace List   Class Hierarchy   Alphabetical List   Compound List   File List   Namespace Members   Compound Members   File Members   Related Pages  

TclTextInterp.C

Go to the documentation of this file.
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 

Generated on Mon Nov 11 02:45:51 2024 for VMD (current) by doxygen1.2.14 written by Dimitri van Heesch, © 1997-2002