TCL shell extension delegates to dot commands

FossilOrigin-Name: 353943108b36cabb3b9c745aa7f4d9a42cd100b7d0444373184b45cc1715837e

diff --git a/ext/misc/tclshext.c.in b/ext/misc/tclshext.c.in
index c7dba8107c2e26447836ee91adccf775394cc49f..2ab9653684636a3d20e4d6cc046a7b115fbaf85b 100644 (file)
--- a/ext/misc/tclshext.c.in
+++ b/ext/misc/tclshext.c.in
@@ -244,8 +244,8 @@ static DotCmdRC tclRunScript(void *pvState, const char *zScript,
 #define GETLINE_MAXLEN 1000
 
 /* C implementation of TCL proc, get_input_line */
-int getInputLine(void *pvSS, Tcl_Interp *interp,
-                 int nArgs, const char *azArgs[]){
+static int getInputLine(void *pvSS, Tcl_Interp *interp,
+                        int nArgs, const char *azArgs[]){
   if( nArgs==1 ){
     char buffer[GETLINE_MAXLEN+1];
     ShellExState *psx = (ShellExState *)pvSS;
@@ -263,8 +263,8 @@ int getInputLine(void *pvSS, Tcl_Interp *interp,
 }
 
 /* C implementation of TCL proc, now_interactive */
-int nowInteractive(void *pvSS, Tcl_Interp *interp,
-                 int nArgs, const char *azArgs[]){
+static int nowInteractive(void *pvSS, Tcl_Interp *interp,
+                          int nArgs, const char *azArgs[]){
   if( nArgs==1 ){
     ShellExState *psx = (ShellExState *)pvSS;
     struct InSource *pis = pExtHelpers->currentInputSource(psx);
@@ -278,7 +278,61 @@ int nowInteractive(void *pvSS, Tcl_Interp *interp,
   }
 }
 
-/* ToDo: C implementation of TCL ::unknown to reflect to dot commands */
+#define UNKNOWN_RENAME "::_original_unknown"
+
+/* C implementation of TCL ::unknown to delegate to dot commands */
+static int unknown_dot_delegate(void *pvSS, Tcl_Interp *interp,
+                                int nArgs, const char *azArgs[]){
+  const char *name = (nArgs>1 && *azArgs[1]=='.')? azArgs[1]+1 : 0;
+  ShellExState *psx = (ShellExState *)pvSS;
+  MetaCommand *pmc = 0;
+  int nFound = 0;
+  int ia, rc;
+
+  if( name ) pmc = pExtHelpers->findMetaCommand(name, psx, &nFound);
+  if( pmc &&nFound==1 ){
+    /* Run the dot command and interpret its returns. */
+    char *zErr = 0;
+    DotCmdRC drc = pmc->pMethods->argsCheck(pmc, &zErr, nArgs-1,
+                                            (char **)azArgs+1);
+    if( drc==DCR_Ok ){
+      drc = pmc->pMethods->execute(pmc, psx, &zErr, nArgs-1,
+                                   (char **)azArgs+1);
+    }
+    assert(!(drc==DCR_Ok && zErr!=0));
+    if( drc==DCR_Ok ) return TCL_OK;
+    else{
+      /* ToDo: Try to indicate what went wrong as part of result. 
+       * This is deferred until some shell functionality helping
+       * with this is factored out and exposed for extensions. */
+      sqlite3_free(zErr);
+      return TCL_ERROR;
+    }
+  }else{
+    /* Defer to the TCL-default ::unknown command, or fail here. */
+    int haveUnkCmd = (0!=Tcl_FindCommand(interp, UNKNOWN_RENAME,
+                                         0, TCL_GLOBAL_ONLY));
+    Tcl_Obj **ppo;
+    if( haveUnkCmd ){
+      ppo = sqlite3_malloc((nArgs+1)*sizeof(Tcl_Obj*));
+      if( ppo==0 ) return TCL_ERROR;
+      ppo[0] = Tcl_NewStringObj(UNKNOWN_RENAME, -1);
+      Tcl_IncrRefCount(ppo[0]);
+      for( ia=1; ia<nArgs; ++ia ){
+        ppo[ia] = Tcl_NewStringObj(azArgs[ia], -1);
+        Tcl_IncrRefCount(ppo[ia]);
+      }
+      rc = Tcl_EvalObjv(interp, nArgs, ppo, TCL_EVAL_GLOBAL);
+      for( ia=0; ia<nArgs; ++ia ) Tcl_DecrRefCount(ppo[ia]);
+      return TCL_OK;
+    }else{
+      /* Fail now (instead of recursing back into this handler.) */
+      Tcl_AppendResult(interp,
+                       "Command ", azArgs[1], " does not exist.", (char *)0);
+      return TCL_ERROR;
+    }
+  }
+}
 
 /* ToDo: ... TCL db_user command, like a (TCL) sqlite3 object except that
  * it defers to shell's db and treats close subcommand as an error. */
@@ -321,22 +375,31 @@ int sqlite3_tclshext_init(
       }
     }
     tclcmd.interp = Tcl_CreateInterp();
+    Tcl_SetSystemEncoding(tclcmd.interp, "utf-8");
+    Sqlite3_Init(tclcmd.interp);
     if( 0==Tcl_OOInitStubs(tclcmd.interp) ){
       *pzErrMsg = sqlite3_mprintf("Tcl v8.6 or higher required.\n");
       TclCmd_Takedown(&tclcmd);
       return SQLITE_ERROR;
     }
-    Tcl_SetSystemEncoding(tclcmd.interp, "utf-8");
-    Sqlite3_Init(tclcmd.interp);
     rc = pShExtApi->registerMetaCommand(psx, sqlite3_tclshext_init, pmc);
     if( rc==SQLITE_OK ){
       ScriptHooks sh = { pmc, tclIsScriptLead, tclIsComplete, tclRunScript };
-      pShExtApi->hookScripting(psx, sqlite3_tclshext_init, &sh);
-      Tcl_CreateCommand(tclcmd.interp,
-                        "get_input_line", getInputLine, psx, 0);
-      Tcl_CreateCommand(tclcmd.interp,
-                        "now_interactive", nowInteractive, psx, 0);
-      pShExtLink->eid = sqlite3_tclshext_init;
+      int irc = Tcl_Init(tclcmd.interp);
+      if( irc==TCL_OK ){
+        pShExtApi->hookScripting(psx, sqlite3_tclshext_init, &sh);
+        Tcl_CreateCommand(tclcmd.interp,
+                          "get_input_line", getInputLine, psx, 0);
+        Tcl_CreateCommand(tclcmd.interp,
+                          "now_interactive", nowInteractive, psx, 0);
+        Tcl_Eval(tclcmd.interp, "rename unknown "UNKNOWN_RENAME);
+        Tcl_CreateCommand(tclcmd.interp,
+                          "unknown", unknown_dot_delegate, psx, 0);
+        pShExtLink->eid = sqlite3_tclshext_init;
+      }else{
+        TclCmd_Takedown(&tclcmd);
+        rc = SQLITE_ERROR;
+      }
     }else{
       TclCmd_Takedown(&tclcmd);
     }

diff --git a/manifest b/manifest
index 87bbba5b5a0ae947630729176a79fa3bc9fc45c4..6f7b09a6f61052fb2188185df7da73f1f1f597c8 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Scripting\ssupport\sroughed\sin,\swith\sa\sdemo\sextension.\sMore\swork\sis\sneeded\sto\smake\sthis\struly\suseful.\sTests\sare\smissing.
-D 2022-03-23T21:03:48.356
+C TCL\sshell\sextension\sdelegates\sto\sdot\scommands
+D 2022-03-24T12:49:05.311
 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
 F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724
@@ -329,7 +329,7 @@ F ext/misc/showauth.c 732578f0fe4ce42d577e1c86dc89dd14a006ab52
 F ext/misc/spellfix.c 94df9bbfa514a563c1484f684a2df3d128a2f7209a84ca3ca100c68a0163e29f
 F ext/misc/sqlar.c 0ace5d3c10fe736dc584bf1159a36b8e2e60fab309d310cd8a0eecd9036621b6
 F ext/misc/stmt.c 35063044a388ead95557e4b84b89c1b93accc2f1c6ddea3f9710e8486a7af94a
-F ext/misc/tclshext.c.in 9e8909361fb8e26488920acd6629753b5bf38541cd0c4e6a16f6532b7bf367c6
+F ext/misc/tclshext.c.in 4c9e9c36877ea3a9bde62e4d4706e848fe0d56984e7ad36d5952de7f9d9cf308
 F ext/misc/templatevtab.c 8a16a91a5ceaccfcbd6aaaa56d46828806e460dd194965b3f77bf38f14b942c4
 F ext/misc/totype.c fa4aedeb07f66169005dffa8de3b0a2b621779fd44f85c103228a42afa71853b
 F ext/misc/uint.c 053fed3bce2e89583afcd4bf804d75d659879bbcedac74d0fa9ed548839a030b
@@ -1950,9 +1950,8 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93
 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
 F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
 F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
-P 7996d3a359ab90ef9f42f501e0ddb2efa964a906739116836cb1eafe2a96a0ed
-Q +da874180d35aacdeb9c06f5b425e8909d833e2765179c4337854d56b8a624fd5
-R c463fc7c0074cded5ea87643f5ddeef3
+P abf0316b3f58646974ab8e4d3e68896c9fc03bdd338eb7dc7b2f5d4de7365298
+R ce874ae1862d105669b12cd18d25e5bc
 U larrybr
-Z cf7f7bb9e5e070c2442801336636b4c2
+Z 4469eea4a17023c287722633d65da7c8
 # Remove this line to create a well-formed Fossil manifest.

diff --git a/manifest.uuid b/manifest.uuid
index 3924874b4312b3bec82e92a929f73eb8da251d29..85e7c769770f9124875f30a3a85db51b59dd927e 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-abf0316b3f58646974ab8e4d3e68896c9fc03bdd338eb7dc7b2f5d4de7365298
\ No newline at end of file
+353943108b36cabb3b9c745aa7f4d9a42cd100b7d0444373184b45cc1715837e
\ No newline at end of file