add support for [info source ?filename line?]

Allows a script to be created with explicit source info

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 48 insertions, 29 deletions

diff --git a/Tcl_shipped.html b/Tcl_shipped.html
index 1bcf6ff..d1b5829 100644
--- a/Tcl_shipped.html
+++ b/Tcl_shipped.html
@@ -888,10 +888,10 @@ Support for UDP, IPv6, Unix-Domain sockets in addition to TCP sockets
 <li>
 <p>
 <a href="#_file"><strong><code>file</code></strong></a> <code>copy</code> <em>-force</em> handles source and target as the same file
-</p>

-</li>

-<li>

-<p>

+</p>
+</li>
+<li>
+<p>
 <a href="#_format"><strong><code>format</code></strong></a> now supports <code>%b</code> for binary conversion
 </p>

 </li>

@@ -928,16 +928,21 @@ Add <em>--random-hash</em> to randomise hash tables for greater security
 <li>

 <p>

 Add support for <a href="#_file"><strong><code>file</code></strong></a> <code>link</code>
+</p>

+</li>

+<li>

+<p>

+<a href="#_glob"><strong><code>glob</code></strong></a> now supports the <em>--tails</em> option
 </p>
 </li>
 <li>
 <p>
-<a href="#_glob"><strong><code>glob</code></strong></a> now supports the <em>--tails</em> option
+Add support for <a href="#_string"><strong><code>string</code></strong></a> <code>cat</code>
 </p>
 </li>
 <li>
 <p>
-Add support for <a href="#_string"><strong><code>string</code></strong></a> <code>cat</code>
+Allow <a href="#_info"><strong><code>info</code></strong></a> <code>source</code> to add source info
 </p>

 </li>

 </ol></div>

@@ -4696,13 +4701,15 @@ The legal <code><em>option</em></code>'s (which may be abbreviated) are:
 </p>

 </dd>

 <dt class="hdlist1">

-<code><strong>info source</strong> <em>script</em></code>
+<code><strong>info source</strong> <em>script ?filename line?</em></code>
 </dt>

 <dd>

 <p>

-    Returns the original source location of the given script as a list of

+    With a single argument, returns the original source location of the given script as a list of
     <code>{filename linenumber}</code>. If the source location can&#8217;t be determined, the
-    list <code>{{} 0}</code> is returned.
+    list <code>{{} 0}</code> is returned. If <code><em>filename</em></code> and <code><em>line</em></code> are given, returns a copy
+        of <code><em>script</em></code> with the associate source information. This can be useful to produce
+        useful messages from <a href="#_eval"><strong><code>eval</code></strong></a>, etc. if the original source information may be lost.
 </p>

 </dd>

 <dt class="hdlist1">

@@ -8206,7 +8213,7 @@ official policies, either expressed or implied, of the Jim Tcl Project.</code></
 <div id="footnotes"><hr /></div>

 <div id="footer">

 <div id="footer-text">

-Last updated 2014-11-28 15:35:57 AEST
+Last updated 2014-12-09 12:46:16 AEST
 </div>

 </div>

 </body>

diff --git a/jim.c b/jim.c
index 7db453a..be5406a 100644
--- a/jim.c
+++ b/jim.c
@@ -14495,30 +14495,39 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
             break;
 
         case INFO_SOURCE:{
-                int line;
+                jim_wide line;
                 Jim_Obj *resObjPtr;
                 Jim_Obj *fileNameObj;
 
-                if (argc != 3) {
-                    Jim_WrongNumArgs(interp, 2, argv, "source");
+                if (argc != 3 && argc != 5) {
+                    Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?");
                     return JIM_ERR;
                 }
-                if (argv[2]->typePtr == &sourceObjType) {
-                    fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
-                    line = argv[2]->internalRep.sourceValue.lineNumber;
-                }
-                else if (argv[2]->typePtr == &scriptObjType) {
-                    ScriptObj *script = Jim_GetScript(interp, argv[2]);
-                    fileNameObj = script->fileNameObj;
-                    line = script->firstline;
+                if (argc == 5) {
+                    if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) {
+                        return JIM_ERR;
+                    }
+                    resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2]));
+                    JimSetSourceInfo(interp, resObjPtr, argv[3], line);
                 }
                 else {
-                    fileNameObj = interp->emptyObj;
-                    line = 1;
+                    if (argv[2]->typePtr == &sourceObjType) {
+                        fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj;
+                        line = argv[2]->internalRep.sourceValue.lineNumber;
+                    }
+                    else if (argv[2]->typePtr == &scriptObjType) {
+                        ScriptObj *script = Jim_GetScript(interp, argv[2]);
+                        fileNameObj = script->fileNameObj;
+                        line = script->firstline;
+                    }
+                    else {
+                        fileNameObj = interp->emptyObj;
+                        line = 1;
+                    }
+                    resObjPtr = Jim_NewListObj(interp, NULL, 0);
+                    Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
+                    Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
                 }
-                resObjPtr = Jim_NewListObj(interp, NULL, 0);
-                Jim_ListAppendElement(interp, resObjPtr, fileNameObj);
-                Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line));
                 Jim_SetResult(interp, resObjPtr);
                 break;
             }
diff --git a/jim_tcl.txt b/jim_tcl.txt
index 36c4e70..959aff2 100644
--- a/jim_tcl.txt
+++ b/jim_tcl.txt
@@ -65,6 +65,7 @@ Changes between 0.74 and 0.75
 10. Add support for `file link`
 11. `glob` now supports the '--tails' option
 12. Add support for `string cat`
+13. Allow `info source` to add source info
 
 Changes between 0.73 and 0.74
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2735,10 +2736,12 @@ The legal +'option'+'s (which may be abbreviated) are:
     of the innermost file being processed.  Otherwise the command returns an
     empty string.
 
-+*info source* 'script'+::
-    Returns the original source location of the given script as a list of
++*info source* 'script ?filename line?'+::
+    With a single argument, returns the original source location of the given script as a list of
     +{filename linenumber}+. If the source location can't be determined, the
-    list +{{} 0}+ is returned.
+    list +{{} 0}+ is returned. If +'filename'+ and +'line'+ are given, returns a copy
+	of +'script'+ with the associate source information. This can be useful to produce
+	useful messages from `eval`, etc. if the original source information may be lost.
 
 +*info stacktrace*+::
     After an error is caught with `catch`, returns the stack trace as a list