TIP#127 Implementation. Thanks to Michael Schlenker for his implementation work

6 files changed, 601 insertions, 192 deletions

diff --git a/ChangeLog b/ChangeLog
index 25c702e..a65ae8f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2003-10-14  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	TIP#127 IMPLEMENTATION FROM JOE MICHAEL SCHLENKER
+
+	* generic/tclCmdIL.c (SelectObjFromSublist): Element selection engine.
+	* generic/tclCmdIL.c (Tcl_LsearchObjCmd, Tcl_LsortObjCmd): 
+	* tests/lsearch.test:	Set up and use of element selection engine,
+	* tests/cmdIL.test:	plus tests and documentation.
+	* doc/lsearch.n:	Based on [Patch 693836]
+	* doc/lsort.n: 
+
 2003-10-13  Vince Darley  <vincentdarley@users.sourceforge.net>
 
 	* generic/tcl.h: 
diff --git a/doc/lsearch.n b/doc/lsearch.n
index 302a1f5..b2129aa 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -6,10 +6,10 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: lsearch.n,v 1.14 2003/03/17 14:21:40 dkf Exp $
+'\" RCS: @(#) $Id: lsearch.n,v 1.15 2003/10/14 13:38:57 dkf Exp $
 '\" 
 .so man.macros
-.TH lsearch n 8.4 Tcl "Tcl Built-In Commands"
+.TH lsearch n 8.5 Tcl "Tcl Built-In Commands"
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
@@ -23,18 +23,14 @@ lsearch \- See if a list contains a particular element
 This command searches the elements of \fIlist\fR to see if one
 of them matches \fIpattern\fR.  If so, the command returns the index
 of the first matching element
-.VS 8.4
 (unless the options \fB\-all\fR or \fB\-inline\fR are specified.)
-.VE 8.4
 If not, the command returns \fB\-1\fR.  The \fIoption\fR arguments
 indicates how the elements of the list are to be matched against
 \fIpattern\fR and it must have one of the following values:
 .TP
 \fB\-all\fR
-.VS 8.4
 Changes the result to be the list of all matching indices (or all
 matching values if \fB\-inline\fR is specified as well.)
-.VE 8.4
 .TP
 \fB\-ascii\fR
 The list elements are to be examined as Unicode strings (the name is
@@ -61,22 +57,26 @@ element using the same rules as the \fBstring match\fR command.
 The list elements are sorted in increasing order.  This option is only
 meaningful when used with \fB\-sorted\fR.
 .TP
+\fB\-index\fR\0\fIindexList\fR
+.VS 8.5
+This option is designed for use when searching within nested lists.
+The \fIindexList\fR gives a path of indices (much as might be used
+with the \fBlsearch\fR command) within each element to allow the
+location of the term being matched against.
+.VE 8.5
+.TP
 \fB\-inline\fR
-.VS 8.4
 The matching value is returned instead of its index (or an empty
 string if no value matches.)  If \fB\-all\fR is also specified, then
 the result of the command is the list of all values that matched.
-.VE 8.4
 .TP
 \fB\-integer\fR
 The list elements are to be compared as integers.  This option is only
 meaningful when used with \fB\-exact\fR or \fB\-sorted\fR.
 .TP
 \fB\-not\fR
-.VS 8.4
 This negates the sense of the match, returning the index of the first
 non-matching value in the list.
-.VE 8.4
 .TP
 \fB\-real\fR
 The list elements are to be compared as floating-point values.  This
@@ -96,13 +96,20 @@ option is mutually exclusive with \fB\-glob\fR and \fB\-regexp\fR, and
 is treated exactly like \fB-exact\fR when either \fB\-all\fR, or
 \fB\-not\fR is specified.
 .TP
-\fB\-start\fR \fIindex\fR
-.VS 8.4
+\fB\-start\fR\0\fIindex\fR
 The list is searched starting at position \fIindex\fR.  If \fIindex\fR
 has the value \fBend\fR, it refers to the last element in the list,
 and \fBend\-\fIinteger\fR refers to the last element in the list minus
 the specified integer offset.
-.VE 8.4
+.TP
+\fB\-subindices\fR
+.VS 8.5
+If this option is given, the index result from this command (or every
+index result when \fB\-all\fR is also specified) will be a complete
+path (suitable for use with \fBlindex\fR or \fBlset\fR) within the
+overall list to the term found.  This option has no effect unless the
+\fI\-index\fR is also specified, and is just a convenience short-cut.
+.VE 8.5
 .PP
 If \fIoption\fR is omitted then it defaults to \fB\-glob\fR.  If more
 than one of \fB\-exact\fR, \fB\-glob\fR, \fB\-regexp\fR, and
@@ -113,7 +120,6 @@ last takes precedence.  If more than one of \fB\-increasing\fR and
 \fB\-decreasing\fR is specified, the option specified last takes
 precedence.
 
-.VS 8.4
 .SH EXAMPLES
 .CS
 lsearch {a b c d e} c => 2
@@ -123,14 +129,12 @@ lsearch -inline -not {a20 b35 c47} b* => a20
 lsearch -all -inline -not {a20 b35 c47} b* => a20 c47
 lsearch -all -not {a20 b35 c47} b* => 0 2
 lsearch -start 3 {a b c a b c} c => 5
+lsearch -index 1 -all {{a abc} {b bcd} {c cde}} *bc* => {a abc} {b bcd}
 .CE
-.VE 8.4
 
 .SH "SEE ALSO"
-.VS 8.4
 foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), 
 lset(n), lsort(n), lrange(n), lreplace(n)
-.VE
 
 .SH KEYWORDS
 list, match, pattern, regular expression, search, string
diff --git a/doc/lsort.n b/doc/lsort.n
index 1af8dc6..217c094 100644
--- a/doc/lsort.n
+++ b/doc/lsort.n
@@ -7,7 +7,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: lsort.n,v 1.13 2003/03/17 14:21:41 dkf Exp $
+'\" RCS: @(#) $Id: lsort.n,v 1.14 2003/10/14 13:38:58 dkf Exp $
 '\" 
 .so man.macros
 .TH lsort n 8.3 Tcl "Tcl Built-In Commands"
@@ -65,32 +65,39 @@ This is the default.
 \fB\-decreasing\fR
 Sort the list in decreasing order (``largest'' items first).
 .TP 20
-\fB\-index\0\fIindex\fR
+\fB\-index\0\fIindexList\fR
 If this option is specified, each of the elements of \fIlist\fR must
 itself be a proper Tcl sublist.  Instead of sorting based on whole
-sublists, \fBlsort\fR will extract the \fIindex\fR'th element from
-each sublist and sort based on the given element.  The keyword
-\fBend\fP is allowed for the \fIindex\fP to sort on the last sublist
-element,
-.VS 8.4
-and \fBend-\fIindex\fR sorts on a sublist element offset from
-the end.
-.VE
+sublists, \fBlsort\fR will extract the \fIindexList\fR'th element from
+each sublist
+.VS 8.5
+(as if the overall element and the \fIindexList\fR were passed to
+\fBlindex\fR) and sort based on the given element.  The keyword
+\fBend\fP is allowed for each element of the \fIindexList\fR to sort
+on the last sublist element, and \fBend-\fIindex\fR sorts on a sublist
+element offset from the end.
+.VE 8.5
 For example,
 .RS
 .CS
 lsort -integer -index 1 {{First 24} {Second 18} {Third 30}}
 .CE
 returns \fB{Second 18} {First 24} {Third 30}\fR, and
-.VS 8.4
 '\"
 '\" This example is from the test suite!
 '\"
 .CS
 lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
 .CE
-returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR.
-.VE
+returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR,
+.VS 8.5
+and
+.CS
+lsort -index {0 1} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321}}
+.CE
+returns \fB{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}\fR
+(because \fBe\fR sorts before \fBi\fR which sorts before \fBo\fR.)
+.VE 8.5
 This option is much more efficient than using \fB\-command\fR
 to achieve the same effect.
 .RE
@@ -186,10 +193,8 @@ More complex sorting using a comparison function:
 .CE
 
 .SH "SEE ALSO"
-.VS 8.4
 list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), 
 lset(n), lrange(n), lreplace(n)
-.VE
 
 .SH KEYWORDS
 element, list, order, sort
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 467241d..e9e8685 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.52 2003/08/11 13:26:13 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.53 2003/10/14 13:38:58 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -31,7 +31,7 @@
 typedef struct SortElement {
     Tcl_Obj *objPtr;			/* Object being sorted. */
     int count;				/* number of same elements in list */
-    struct SortElement *nextPtr;        /* Next element in the list, or
+    struct SortElement *nextPtr;	/* Next element in the list, or
 					 * NULL for end of list. */
 } SortElement;
 
@@ -50,8 +50,8 @@ typedef struct SortInfo {
     Tcl_Obj *compareCmdPtr;     /* The Tcl comparison command when sortMode
 				 * is SORTMODE_COMMAND.  Pre-initialized to
 				 * hold base of command.*/
-    int index;			/* If the -index option was specified, this
-				 * holds the index of the list element
+    Tcl_Obj *indexObj;		/* If the -index option was specified, this
+				 * holds the index Obj of the list element
 				 * to extract for comparison.  If -index
 				 * wasn't specified, this is -1. */
     Tcl_Interp *interp;		/* The interpreter in which the sortis
@@ -157,6 +157,9 @@ static SortElement *    MergeLists _ANSI_ARGS_((SortElement *leftPtr,
 			    SortElement *rightPtr, SortInfo *infoPtr));
 static int		SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr,
 			    Tcl_Obj *second, SortInfo *infoPtr));
+static Tcl_Obj *	SelectObjFromSublist _ANSI_ARGS_((Tcl_Obj *firstPtr,
+			    SortInfo *infoPtr));
+
 
 /*
  *----------------------------------------------------------------------
@@ -504,7 +507,7 @@ Tcl_InfoObjCmd(clientData, interp, objc, objv)
  *      Called to implement the "info args" command that returns the
  *      argument list for a procedure. Handles the following syntax:
  *
- *          info args procName
+ *	    info args procName
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -566,7 +569,7 @@ InfoArgsCmd(dummy, interp, objc, objv)
  *      Called to implement the "info body" command that returns the body
  *      for a procedure. Handles the following syntax:
  *
- *          info body procName
+ *	    info body procName
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -635,7 +638,7 @@ InfoBodyCmd(dummy, interp, objc, objv)
  *      number of commands that have been executed. Handles the following
  *      syntax:
  *
- *          info cmdcount
+ *	    info cmdcount
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -677,7 +680,7 @@ InfoCmdCountCmd(dummy, interp, objc, objv)
  *	glob-style pattern that restricts which commands are returned.
  *	Handles the following syntax:
  *
- *          info commands ?pattern?
+ *	    info commands ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -753,7 +756,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
-	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		if (specificNsInPattern) {
 		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
 		    elemObjPtr = Tcl_NewObj();
@@ -779,7 +782,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
 	    while (entryPtr != NULL) {
 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
 		if ((simplePattern == NULL)
-	                || Tcl_StringMatch(cmdName, simplePattern)) {
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
 		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
 			Tcl_ListObjAppendElement(interp, listPtr,
 				Tcl_NewStringObj(cmdName, -1));
@@ -803,7 +806,7 @@ InfoCommandsCmd(dummy, interp, objc, objv)
  *      whether a string is a complete Tcl command. Handles the following
  *      syntax:
  *
- *          info complete command
+ *	    info complete command
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -845,7 +848,7 @@ InfoCompleteCmd(dummy, interp, objc, objv)
  *      default value for a procedure argument. Handles the following
  *      syntax:
  *
- *          info default procName arg varName
+ *	    info default procName arg varName
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -896,7 +899,7 @@ InfoDefaultCmd(dummy, interp, objc, objv)
 		    defStoreError:
 		    varName = Tcl_GetString(objv[4]);
 		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
-	                    "couldn't store default value in variable \"",
+			    "couldn't store default value in variable \"",
 			    varName, "\"", (char *) NULL);
 		    return TCL_ERROR;
 		}
@@ -929,7 +932,7 @@ InfoDefaultCmd(dummy, interp, objc, objv)
  *      Called to implement the "info exists" command that determines
  *      whether a variable exists. Handles the following syntax:
  *
- *          info exists varName
+ *	    info exists varName
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -975,7 +978,7 @@ InfoExistsCmd(dummy, interp, objc, objv)
  *      list of math functions matching an optional pattern. Handles the
  *      following syntax:
  *
- *          info functions ?pattern?
+ *	    info functions ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1023,7 +1026,7 @@ InfoFunctionsCmd(dummy, interp, objc, objv)
  *      of global variables matching an optional pattern. Handles the
  *      following syntax:
  *
- *          info globals ?pattern?
+ *	    info globals ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1089,7 +1092,7 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
  *      Called to implement the "info hostname" command that returns the
  *      host name. Handles the following syntax:
  *
- *          info hostname
+ *	    info hostname
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1133,7 +1136,7 @@ InfoHostnameCmd(dummy, interp, objc, objv)
  *      Called to implement the "info level" command that returns
  *      information about the call stack. Handles the following syntax:
  *
- *          info level ?number?
+ *	    info level ?number?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1207,7 +1210,7 @@ InfoLevelCmd(dummy, interp, objc, objv)
  *      library directory for the Tcl installation. Handles the following
  *      syntax:
  *
- *          info library
+ *	    info library
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1252,7 +1255,7 @@ InfoLibraryCmd(dummy, interp, objc, objv)
  *      packages that have been loaded into an interpreter. Handles the
  *      following syntax:
  *
- *          info loaded ?interp?
+ *	    info loaded ?interp?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1297,7 +1300,7 @@ InfoLoadedCmd(dummy, interp, objc, objv)
  *      local variables that match an optional pattern. Handles the
  *      following syntax:
  *
- *          info locals ?pattern?
+ *	    info locals ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1389,11 +1392,11 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
 	 */
 
 	if (!TclIsVarTemporary(localPtr) && !TclIsVarUndefined(varPtr)
-	        && (includeLinks || !TclIsVarLink(varPtr))) {
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
 	    varName = varPtr->name;
 	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
 		Tcl_ListObjAppendElement(interp, listPtr,
-		        Tcl_NewStringObj(varName, -1));
+			Tcl_NewStringObj(varName, -1));
 	    }
 	}
 	varPtr++;
@@ -1402,14 +1405,14 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
     
     if (localVarTablePtr != NULL) {
 	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
-	        entryPtr != NULL;
+		entryPtr != NULL;
 		entryPtr = Tcl_NextHashEntry(&search)) {
 	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
 	    if (!TclIsVarUndefined(varPtr)
 		    && (includeLinks || !TclIsVarLink(varPtr))) {
 		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
 		if ((pattern == NULL)
-		        || Tcl_StringMatch(varName, pattern)) {
+			|| Tcl_StringMatch(varName, pattern)) {
 		    Tcl_ListObjAppendElement(interp, listPtr,
 			    Tcl_NewStringObj(varName, -1));
 		}
@@ -1427,7 +1430,7 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
  *      the name of the binary file running this application. Handles the
  *      following syntax:
  *
- *          info nameofexecutable
+ *	    info nameofexecutable
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1470,7 +1473,7 @@ InfoNameOfExecutableCmd(dummy, interp, objc, objv)
  *      default value for an argument to a procedure. Handles the following
  *      syntax:
  *
- *          info patchlevel
+ *	    info patchlevel
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1517,7 +1520,7 @@ InfoPatchLevelCmd(dummy, interp, objc, objv)
  *	glob-style pattern that restricts which commands are returned.
  *	Handles the following syntax:
  *
- *          info procs ?pattern?
+ *	    info procs ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1595,14 +1598,14 @@ InfoProcsCmd(dummy, interp, objc, objv)
 	while (entryPtr != NULL) {
 	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
 	    if ((simplePattern == NULL)
-	            || Tcl_StringMatch(cmdName, simplePattern)) {
+		    || Tcl_StringMatch(cmdName, simplePattern)) {
 		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 
 		realCmdPtr = (Command *)
 		    TclGetOriginalCommand((Tcl_Command) cmdPtr);
 
 		if (TclIsProc(cmdPtr)
-		        || ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
+			|| ((realCmdPtr != NULL) && TclIsProc(realCmdPtr))) {
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr,
@@ -1638,16 +1641,16 @@ InfoProcsCmd(dummy, interp, objc, objv)
 	    while (entryPtr != NULL) {
 		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
 		if ((simplePattern == NULL)
-	                || Tcl_StringMatch(cmdName, simplePattern)) {
+			|| Tcl_StringMatch(cmdName, simplePattern)) {
 		    if (Tcl_FindHashEntry(&nsPtr->cmdTable, cmdName) == NULL) {
 			cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
 			realCmdPtr = (Command *) TclGetOriginalCommand(
-			        (Tcl_Command) cmdPtr);
+				(Tcl_Command) cmdPtr);
 
 			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
 				&& TclIsProc(realCmdPtr))) {
 			    Tcl_ListObjAppendElement(interp, listPtr,
-			            Tcl_NewStringObj(cmdName, -1));
+				    Tcl_NewStringObj(cmdName, -1));
 			}
 		    }
 		}
@@ -1670,7 +1673,7 @@ InfoProcsCmd(dummy, interp, objc, objv)
  *      script file that is currently being evaluated. Handles the
  *      following syntax:
  *
- *          info script ?newName?
+ *	    info script ?newName?
  *
  *	If newName is specified, it will set that as the internal name.
  *
@@ -1720,7 +1723,7 @@ InfoScriptCmd(dummy, interp, objc, objv)
  *      returns the file extension used for shared libraries. Handles the
  *      following syntax:
  *
- *          info sharedlibextension
+ *	    info sharedlibextension
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1758,7 +1761,7 @@ InfoSharedlibCmd(dummy, interp, objc, objv)
  *      Called to implement the "info tclversion" command that returns the
  *      version number for this Tcl library. Handles the following syntax:
  *
- *          info tclversion
+ *	    info tclversion
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1805,7 +1808,7 @@ InfoTclVersionCmd(dummy, interp, objc, objv)
  *	glob-style pattern that restricts which variables are returned.
  *	Handles the following syntax:
  *
- *          info vars ?pattern?
+ *	    info vars ?pattern?
  *
  * Results:
  *      Returns TCL_OK if successful and TCL_ERROR if there is an error.
@@ -1897,11 +1900,11 @@ InfoVarsCmd(dummy, interp, objc, objv)
 		    || (varPtr->flags & VAR_NAMESPACE_VAR)) {
 		varName = Tcl_GetHashKey(&nsPtr->varTable, entryPtr);
 		if ((simplePattern == NULL)
-	                || Tcl_StringMatch(varName, simplePattern)) {
+			|| Tcl_StringMatch(varName, simplePattern)) {
 		    if (specificNsInPattern) {
 			elemObjPtr = Tcl_NewObj();
 			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
-			        elemObjPtr);
+				elemObjPtr);
 		    } else {
 			elemObjPtr = Tcl_NewStringObj(varName, -1);
 		    }
@@ -1925,14 +1928,14 @@ InfoVarsCmd(dummy, interp, objc, objv)
 	    while (entryPtr != NULL) {
 		varPtr = (Var *) Tcl_GetHashValue(entryPtr);
 		if (!TclIsVarUndefined(varPtr)
-		        || (varPtr->flags & VAR_NAMESPACE_VAR)) {
-		    varName = Tcl_GetHashKey(&globalNsPtr->varTable,
-			    entryPtr);
+			|| (varPtr->flags & VAR_NAMESPACE_VAR)) {
+		    varName = Tcl_GetHashKey(&globalNsPtr->varTable, entryPtr);
 		    if ((simplePattern == NULL)
-	                    || Tcl_StringMatch(varName, simplePattern)) {
-			if (Tcl_FindHashEntry(&nsPtr->varTable, varName) == NULL) {
+			    || Tcl_StringMatch(varName, simplePattern)) {
+			if (Tcl_FindHashEntry(&nsPtr->varTable,
+				varName) == NULL) {
 			    Tcl_ListObjAppendElement(interp, listPtr,
-			            Tcl_NewStringObj(varName, -1));
+				    Tcl_NewStringObj(varName, -1));
 			}
 		    }
 		}
@@ -2173,13 +2176,12 @@ TclLindexList( interp, listPtr, argPtr )
 	}
 	    
 	/*
-	 * Get the index from indices[ i ]
+	 * Get the index from indices[i]
 	 */
 	
-	result = TclGetIntForIndex( interp, indices[ i ],
-				    /*endValue*/ (listLen - 1),
-				    &index );
-	if ( result != TCL_OK ) {
+	result = TclGetIntForIndex(interp, indices[i], /*endValue*/ listLen-1,
+		&index);
+	if (result != TCL_OK) {
 	    /*
 	     * Index could not be parsed
 	     */
@@ -2864,21 +2866,23 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     char *bytes, *patternBytes;
     int i, match, mode, index, result, listc, length, elemLen;
     int dataType, isIncreasing, lower, upper, patInt, objInt;
-    int offset, allMatches, inlineReturn, negatedMatch;
+    int offset, allMatches, inlineReturn, negatedMatch, returnSubindices;
     double patDouble, objDouble;
-    Tcl_Obj *patObj, **listv, *listPtr, *startPtr;
+    SortInfo sortInfo;
+    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
     Tcl_RegExp regexp = NULL;
     static CONST char *options[] = {
-	"-all",	    "-ascii", "-decreasing", "-dictionary",
-	"-exact",   "-glob",  "-increasing", "-inline",
-	"-integer", "-not",   "-real",	     "-regexp",
-	"-sorted",  "-start", NULL
+	"-all",	    "-ascii",   "-decreasing", "-dictionary",
+	"-exact",   "-glob",    "-increasing", "-index",
+	"-inline",  "-integer", "-not",        "-real",
+	"-regexp",  "-sorted",  "-start",      "-subindices",
+	NULL
     };
     enum options {
 	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
-	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INLINE,
-	LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP,
-	LSEARCH_SORTED, LSEARCH_START
+	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
+	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOT, LSEARCH_REAL,
+	LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START, LSEARCH_SUBINDICES
     };
     enum datatypes {
 	ASCII, DICTIONARY, INTEGER, REAL
@@ -2892,10 +2896,17 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     isIncreasing = 1;
     allMatches = 0;
     inlineReturn = 0;
+    returnSubindices = 0;
     negatedMatch = 0;
     listPtr = NULL;
     startPtr = NULL;
     offset = 0;
+    sortInfo.compareCmdPtr = NULL;
+    sortInfo.isIncreasing = 0;
+    sortInfo.sortMode = 0;
+    sortInfo.interp = interp;
+    sortInfo.resultCode = TCL_OK;
+    sortInfo.indexObj = NULL;
 
     if (objc < 3) {
 	Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
@@ -2905,9 +2916,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     for (i = 1; i < objc-2; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
 		!= TCL_OK) {
-	    if (startPtr) {
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
+	    if (sortInfo.indexObj != NULL) {
+		Tcl_DecrRefCount(sortInfo.indexObj);
+	    }
 	    return TCL_ERROR;
 	}
 	switch ((enum options) index) {
@@ -2950,16 +2964,22 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	case LSEARCH_SORTED:		/* -sorted */
 	    mode = SORTED;
 	    break;
+	case LSEARCH_SUBINDICES:	/* -subindices */
+	    returnSubindices = 1;
+	    break;
 	case LSEARCH_START:		/* -start */
 	    /*
 	     * If there was a previous -start option, release its saved
 	     * index because it will either be replaced or there will be
 	     * an error.
 	     */
-	    if (startPtr) {
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
 	    if (i > objc-4) {
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
 		Tcl_AppendResult(interp, "missing starting index", NULL);
 		return TCL_ERROR;
 	    }
@@ -2977,7 +2997,57 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 		startPtr = objv[i];
 		Tcl_IncrRefCount(startPtr);
 	    }
+	    break;
+	case LSEARCH_INDEX:		/* -index */
+	    if (i > objc-4) {
+		if (startPtr != NULL) {
+		    Tcl_DecrRefCount(startPtr);
+		}
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
+		Tcl_AppendResult(interp,
+			"\"-index\" option must be followed by list index",
+			NULL);
+		return TCL_ERROR;
+	    }
+
+	    /*
+	     * Store pointer to index for processing by sublist
+	     * extraction.
+	     */
+	    if (sortInfo.indexObj != NULL) {
+		Tcl_DecrRefCount(sortInfo.indexObj);
+	    }
+	    i++;
+	    if (objv[i] == objv[objc - 2]) {
+		/*
+		 * Take copy to prevent shimmering problems.  Note
+		 * that it does not matter if the index obj is also a
+		 * component of the list being searched.  We only need
+		 * to copy where the list and the index are
+		 * one-and-the-same.
+		 */
+		sortInfo.indexObj = Tcl_DuplicateObj(objv[i]);
+	    } else {
+		sortInfo.indexObj = objv[i];
+		Tcl_IncrRefCount(sortInfo.indexObj);
+	    }
+	    break;
+	}
+    }
+
+    /*
+     * Subindices only make sense if asked for with -index option set.
+     */
+
+    if (returnSubindices && sortInfo.indexObj==NULL) {
+	if (startPtr != NULL) {
+	    Tcl_DecrRefCount(startPtr);
 	}
+	Tcl_AppendResult(interp,
+		"-subindices cannot be used without -index option", NULL);
+	return TCL_ERROR;
     }
 
     if ((enum modes) mode == REGEXP) {
@@ -2988,9 +3058,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
 		TCL_REG_ADVANCED | TCL_REG_NOSUB);
 	if (regexp == NULL) {
-	    if (startPtr) {
+	    if (startPtr != NULL) {
 		Tcl_DecrRefCount(startPtr);
 	    }
+	    if (sortInfo.indexObj != NULL) {
+		Tcl_DecrRefCount(sortInfo.indexObj);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -3002,9 +3075,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 
     result = Tcl_ListObjGetElements(interp, objv[objc - 2], &listc, &listv);
     if (result != TCL_OK) {
-	if (startPtr) {
+	if (startPtr != NULL) {
 	    Tcl_DecrRefCount(startPtr);
 	}
+	if (sortInfo.indexObj != NULL) {
+	    Tcl_DecrRefCount(sortInfo.indexObj);
+	}
 	return result;
     }
 
@@ -3015,6 +3091,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	result = TclGetIntForIndex(interp, startPtr, listc-1, &offset);
 	Tcl_DecrRefCount(startPtr);
 	if (result != TCL_OK) {
+	    if (sortInfo.indexObj != NULL) {
+		Tcl_DecrRefCount(sortInfo.indexObj);
+	    }
 	    return result;
 	}
 	if (offset > listc-1) {
@@ -3036,12 +3115,18 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	case INTEGER:
 	    result = Tcl_GetIntFromObj(interp, patObj, &patInt);
 	    if (result != TCL_OK) {
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
 		return result;
 	    }
 	    break;
 	case REAL:
 	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
 	    if (result != TCL_OK) {
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
 		return result;
 	    }
 	    break;
@@ -3068,20 +3153,30 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	 */
 	lower = offset - 1;
 	upper = listc;
-	while (lower + 1 != upper) {
+	while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
 	    i = (lower + upper)/2;
+	    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+	    if (sortInfo.resultCode != TCL_OK) {
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
+		return sortInfo.resultCode;
+	    }
 	    switch ((enum datatypes) dataType) {
 	    case ASCII:
-		bytes = Tcl_GetString(listv[i]);
+		bytes = Tcl_GetString(itemPtr);
 		match = strcmp(patternBytes, bytes);
 		break;
 	    case DICTIONARY:
-		bytes = Tcl_GetString(listv[i]);
+		bytes = Tcl_GetString(itemPtr);
 		match = DictionaryCompare(patternBytes, bytes);
 		break;
 	    case INTEGER:
-		result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+		result = Tcl_GetIntFromObj(interp, itemPtr, &objInt);
 		if (result != TCL_OK) {
+		    if (sortInfo.indexObj != NULL) {
+			Tcl_DecrRefCount(sortInfo.indexObj);
+		    }
 		    return result;
 		}
 		if (patInt == objInt) {
@@ -3093,8 +3188,11 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 		}
 		break;
 	    case REAL:
-		result = Tcl_GetDoubleFromObj(interp, listv[i], &objDouble);
+		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
 		if (result != TCL_OK) {
+		    if (sortInfo.indexObj != NULL) {
+			Tcl_DecrRefCount(sortInfo.indexObj);
+		    }
 		    return result;
 		}
 		if (patDouble == objDouble) {
@@ -3148,55 +3246,75 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	}
 	for (i = offset; i < listc; i++) {
 	    match = 0;
+	    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+	    if (sortInfo.resultCode != TCL_OK) {
+		if (listPtr != NULL) {
+		    Tcl_DecrRefCount(listPtr);
+		}
+		if (sortInfo.indexObj != NULL) {
+		    Tcl_DecrRefCount(sortInfo.indexObj);
+		}
+		return sortInfo.resultCode;
+	    }
 	    switch ((enum modes) mode) {
 	    case SORTED:
 	    case EXACT:
 		switch ((enum datatypes) dataType) {
 		case ASCII:
-		    bytes = Tcl_GetStringFromObj(listv[i], &elemLen);
+		    bytes = Tcl_GetStringFromObj(itemPtr, &elemLen);
 		    if (length == elemLen) {
 			match = (memcmp(bytes, patternBytes,
 				(size_t) length) == 0);
 		    }
 		    break;
 		case DICTIONARY:
-		    bytes = Tcl_GetString(listv[i]);
+		    bytes = Tcl_GetString(itemPtr);
 		    match = (DictionaryCompare(bytes, patternBytes) == 0);
 		    break;
+
 		case INTEGER:
-		    result = Tcl_GetIntFromObj(interp, listv[i], &objInt);
+		    result = Tcl_GetIntFromObj(interp, itemPtr, &objInt);
 		    if (result != TCL_OK) {
-			if (listPtr) {
+			if (listPtr != NULL) {
 			    Tcl_DecrRefCount(listPtr);
 			}
+			if (sortInfo.indexObj != NULL) {
+			    Tcl_DecrRefCount(sortInfo.indexObj);
+			}
 			return result;
 		    }
 		    match = (objInt == patInt);
 		    break;
+
 		case REAL:
-		    result = Tcl_GetDoubleFromObj(interp, listv[i],
-			    &objDouble);
+		    result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
 		    if (result != TCL_OK) {
 			if (listPtr) {
 			    Tcl_DecrRefCount(listPtr);
 			}
+			if (sortInfo.indexObj != NULL) {
+			    Tcl_DecrRefCount(sortInfo.indexObj);
+			}
 			return result;
 		    }
 		    match = (objDouble == patDouble);
 		    break;
 		}
 		break;
+
 	    case GLOB:
-		match = Tcl_StringMatch(Tcl_GetString(listv[i]),
-			patternBytes);
+		match = Tcl_StringMatch(Tcl_GetString(itemPtr), patternBytes);
 		break;
 	    case REGEXP:
-		match = Tcl_RegExpExecObj(interp, regexp, listv[i], 0, 0, 0);
+		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
 		if (match < 0) {
 		    Tcl_DecrRefCount(patObj);
-		    if (listPtr) {
+		    if (listPtr != NULL) {
 			Tcl_DecrRefCount(listPtr);
 		    }
+		    if (sortInfo.indexObj != NULL) {
+			Tcl_DecrRefCount(sortInfo.indexObj);
+		    }
 		    return TCL_ERROR;
 		}
 		break;
@@ -3207,19 +3325,28 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
 	    if (negatedMatch) {
 		match = !match;
 	    }
-	    if (match != 0) {
-		if (!allMatches) {
-		    index = i;
-		    break;
-		} else if (inlineReturn) {
-		    /*
-		     * Note that these appends are not expected to fail.
-		     */
-		    Tcl_ListObjAppendElement(interp, listPtr, listv[i]);
+	    if (!match) {
+		continue;
+	    }
+	    if (!allMatches) {
+		index = i;
+		break;
+	    } else if (inlineReturn) {
+		/*
+		 * Note that these appends are not expected to fail.
+		 */
+		if (returnSubindices) {
+		    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
 		} else {
-		    Tcl_ListObjAppendElement(interp, listPtr,
-			    Tcl_NewIntObj(i));
+		    itemPtr = listv[i];
 		}
+		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+	    } else if (returnSubindices) {
+		itemPtr = Tcl_NewIntObj(i);
+		Tcl_ListObjAppendList(interp, itemPtr, sortInfo.indexObj);
+		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+	    } else {
+		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
 	    }
 	}
     }
@@ -3230,7 +3357,13 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     if (allMatches) {
 	Tcl_SetObjResult(interp, listPtr);
     } else if (!inlineReturn) {
-	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+	if (returnSubindices) {
+	    itemPtr = Tcl_NewIntObj(index);
+	    Tcl_ListObjAppendList(interp, itemPtr, sortInfo.indexObj);
+	    Tcl_SetObjResult(interp, itemPtr);
+	} else {
+	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
+	}
     } else if (index < 0) {
 	/*
 	 * Is this superfluous?  The result should be a blank object
@@ -3240,6 +3373,12 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv)
     } else {
 	Tcl_SetObjResult(interp, listv[index]);
     }
+    /*
+     * Cleanup the index list reference
+     */
+    if (sortInfo.indexObj != NULL) {
+	Tcl_DecrRefCount(sortInfo.indexObj);
+    }
     return TCL_OK;
 }
 
@@ -3373,7 +3512,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 
     sortInfo.isIncreasing = 1;
     sortInfo.sortMode = SORTMODE_ASCII;
-    sortInfo.index = SORTIDX_NONE;
+    sortInfo.indexObj = NULL;
     sortInfo.interp = interp;
     sortInfo.resultCode = TCL_OK;
     cmdPtr = NULL;
@@ -3414,10 +3553,8 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 			    -1);
 		    return TCL_ERROR;
 		}
-		if (TclGetIntForIndex(interp, objv[i+1], SORTIDX_END,
-			&sortInfo.index) != TCL_OK) {
-		    return TCL_ERROR;
-		}
+                sortInfo.indexObj = objv[i+1];
+		Tcl_IncrRefCount(sortInfo.indexObj);
 		i++;
 		break;
 	    case 6:			/* -integer */
@@ -3495,6 +3632,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 	Tcl_DecrRefCount(sortInfo.compareCmdPtr);
 	sortInfo.compareCmdPtr = NULL;
     }
+    if (sortInfo.indexObj != NULL) {
+        Tcl_DecrRefCount(sortInfo.indexObj);
+    }
     return sortInfo.resultCode;
 }
 
@@ -3655,75 +3795,26 @@ SortCompare(objPtr1, objPtr2, infoPtr)
     SortInfo *infoPtr;                  /* Information passed from the
 					 * top-level "lsort" command */
 {
-    int order, listLen, index;
-    Tcl_Obj *objPtr;
-    char buffer[TCL_INTEGER_SPACE];
+    int order;
 
     order = 0;
     if (infoPtr->resultCode != TCL_OK) {
 	/*
-	 * Once an error has occurred, skip any future comparisons
-	 * so as to preserve the error message in sortInterp->result.
+	 * Once an error has occurred, skip any future comparisons so
+	 * as to preserve the error message in sortInterp->result.
 	 */
-
 	return order;
     }
-    if (infoPtr->index != SORTIDX_NONE) {
-	/*
-	 * The "-index" option was specified.  Treat each object as a
-	 * list, extract the requested element from each list, and
-	 * compare the elements, not the lists.  "end"-relative indices
-	 * are signaled here with large negative values.
-	 */
 
-	if (Tcl_ListObjLength(infoPtr->interp, objPtr1, &listLen) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (infoPtr->index < SORTIDX_NONE) {
-	    index = listLen + infoPtr->index + 1;
-	} else {
-	    index = infoPtr->index;
-	}
-
-	if (Tcl_ListObjIndex(infoPtr->interp, objPtr1, index, &objPtr)
-		!= TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (objPtr == NULL) {
-	    objPtr = objPtr1;
-	    missingElement:
-	    TclFormatInt(buffer, infoPtr->index);
-	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
-			"element ", buffer, " missing from sublist \"",
-			Tcl_GetString(objPtr), "\"", (char *) NULL);
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	objPtr1 = objPtr;
-
-	if (Tcl_ListObjLength(infoPtr->interp, objPtr2, &listLen) != TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (infoPtr->index < SORTIDX_NONE) {
-	    index = listLen + infoPtr->index + 1;
-	} else {
-	    index = infoPtr->index;
-	}
-
-	if (Tcl_ListObjIndex(infoPtr->interp, objPtr2, index, &objPtr)
-		!= TCL_OK) {
-	    infoPtr->resultCode = TCL_ERROR;
-	    return order;
-	}
-	if (objPtr == NULL) {
-	    objPtr = objPtr2;
-	    goto missingElement;
-	}
-	objPtr2 = objPtr;
+    objPtr1 = SelectObjFromSublist(objPtr1,infoPtr);
+    if (infoPtr->resultCode != TCL_OK) {
+	return order;
+    }
+    objPtr2 = SelectObjFromSublist(objPtr2,infoPtr);
+    if (infoPtr->resultCode != TCL_OK) {
+	return order;
     }
+
     if (infoPtr->sortMode == SORTMODE_ASCII) {
 	order = strcmp(Tcl_GetString(objPtr1), Tcl_GetString(objPtr2));
     } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
@@ -3933,3 +4024,200 @@ DictionaryCompare(left, right)
     }
     return diff;
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelectObjFromSublist --
+ *
+ *	This procedure is invoked from lsearch and SortCompare.  It is
+ *	used for implementing the -index option, for the lsort and
+ *	lsearch commands.
+ *
+ * Results:
+ *      Returns NULL if a failure occurs, and sets the result in the
+ *      infoPtr.  Otherwise returns the Tcl_Obj* to the item.
+ *
+ * Side effects:
+ *      None.
+ *
+ * Note:
+ *      No reference counting is done, as the result is only used
+ *      internally and never passed directly to user code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+SelectObjFromSublist(objPtr, infoPtr)
+    Tcl_Obj *objPtr;			/* Obj to select sublist from. */
+    SortInfo *infoPtr;			/* Information passed from the
+					 * top-level "lsearch" or "lsort"
+					 * command. */
+{
+    int listLen, index, baseIndex, result, i;
+    Tcl_Obj *currentObj;		/* Current object being processed. */
+    Tcl_Obj **indices;			/* Array of list indices. */
+    Tcl_Obj **elemPtrs;			/* Elements of the list being
+					 * manipulated. */
+    int indexCount;			/* Size of the indices array. */
+    char buffer[TCL_INTEGER_SPACE];
+
+    /*
+     * Quick check for case when no "-index" option is there.
+     */
+
+    if (infoPtr->indexObj == NULL) {
+	return objPtr;
+    }
+
+    /*
+     * The "-index" option was specified.  Treat each object as a
+     * list, extract the requested element from each list.
+     */
+
+    /*
+     * Detect if we have only one index or a list of indices.
+     */
+
+    if (infoPtr->indexObj->typePtr != &tclListType
+	    && TclGetIntForIndex(NULL, infoPtr->indexObj, SORTIDX_END,
+		    &baseIndex) == TCL_OK) {
+	/*
+	 * Flat case, only one index given
+	 */
+
+	if (Tcl_ListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+
+	if (baseIndex < SORTIDX_NONE) {
+	    index = listLen + baseIndex + 1;
+	} else {
+	    index = baseIndex;
+	}
+
+	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
+		&currentObj) != TCL_OK) {
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+
+	if (currentObj == NULL) {
+	    TclFormatInt(buffer, index);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+		    "element ", buffer, " missing from sublist \"",
+		    Tcl_GetString(objPtr), "\"", (char *) NULL);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+
+	/*
+	 * currentObj contains element, we are done
+	 */
+
+	return currentObj;
+    }
+
+    /*
+     * Non flat case, index should be a list of indices.
+     */
+
+    if (Tcl_ListObjGetElements(NULL, infoPtr->indexObj, &indexCount,
+	    &indices) != TCL_OK) {
+	/*
+	 * infoPtr->indexObj designates something that is neither an
+	 * index nor a well-formed list.  Report the error..
+	 */
+
+	Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+		"argument \"", Tcl_GetString(infoPtr->indexObj),
+		"\" given to -index is invalid", (char *) NULL);
+	infoPtr->resultCode = TCL_ERROR;
+	return NULL;
+    }
+
+    /*
+     * infoPtr designates a list, and we've parsed it into indexCount
+     * and indices.
+     */
+
+    currentObj = objPtr;
+    for (i=0 ; i<indexCount ; i++) {
+	/*
+	 * Convert the current object to a list if necessary.
+	 */
+
+	result = Tcl_ListObjGetElements(infoPtr->interp, currentObj,
+		&listLen, &elemPtrs);
+	if (result != TCL_OK) {
+	    infoPtr->resultCode = result;
+	    return NULL;
+	}
+
+	/*
+	 * Get the index from indices[i], taking care of any end-x
+	 * notation.
+	 */
+
+	result = TclGetIntForIndex(infoPtr->interp, indices[i], SORTIDX_END,
+		&baseIndex);
+	if (result != TCL_OK) {
+	    infoPtr->resultCode = result;
+	    return NULL;
+	}
+	if (baseIndex < SORTIDX_NONE) {
+	    index = listLen + baseIndex + 1;
+	} else {
+	    index = baseIndex;
+	}
+	if (index >= listLen || index < 0) {
+	    TclFormatInt(buffer, index);
+	    Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->interp),
+		    "element ", buffer, " missing from sublist \"",
+		    Tcl_GetString(currentObj), "\"", (char *) NULL);
+	    infoPtr->resultCode = TCL_ERROR;
+	    return NULL;
+	}
+
+	/*
+	 * Make sure listPtr still refers to a list object.  If it
+	 * shared a Tcl_Obj structure with the arguments, then it
+	 * might have just been converted to something else.
+	 */
+
+	if (currentObj->typePtr != &tclListType) {
+	    result = Tcl_ListObjGetElements(infoPtr->interp, currentObj,
+		    &listLen, &elemPtrs);
+	    if (result != TCL_OK) {
+		infoPtr->resultCode = result;
+		return NULL;
+	    }
+	}
+
+	/*
+	 * Extract the pointer to the appropriate element.
+	 */
+
+	currentObj = elemPtrs[index];
+
+	/*
+	 * The work we did above may have caused the internal rep
+	 * of *argPtr to change to something else.  Get it back.
+	 */
+
+	result = Tcl_ListObjGetElements(infoPtr->interp, infoPtr->indexObj,
+		&indexCount, &indices);
+	if (result != TCL_OK) {
+	    /*
+	     * This can't happen unless some extension corrupted a
+	     * Tcl_Obj.
+	     */
+	    infoPtr->resultCode = result;
+	    return NULL;
+	}
+    }
+
+    return currentObj;
+}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 01094b1..199fbd5 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdIL.test,v 1.15 2003/07/15 15:42:05 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.16 2003/10/14 13:38:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -356,6 +356,37 @@ test cmdIL-4.33 {DictionaryCompare procedure, chars between Z and a in ASCII} {
     lsort -dictionary [list AA ! c CC `]
 } [list ! ` AA c CC]
 
+test cmdIL-5.1 {lsort with list style index} {
+    lsort -ascii -decreasing -index {0 1} {
+	{{Jim Alpha} 20000410}
+	{{Joe Bravo} 19990320}
+	{{Jacky Charlie} 19390911}
+    }
+} {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}}
+test cmdIL-5.2 {lsort with list style index} {
+    lsort -decreasing -index {0 1} {
+	{{Jim Alpha} 20000410}
+	{{Joe Bravo} 19990320}
+	{{Jacky Charlie} 19390911}
+    }
+} {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}}
+test cmdIL-5.3 {lsort with list style index} {
+    lsort -integer -increasing -index {1 end} {
+	{{Jim Alpha} 20000410}
+	{{Joe Bravo} 19990320}
+	{{Jacky Charlie} 19390911}
+    }
+} {{{Jacky Charlie} 19390911} {{Joe Bravo} 19990320} {{Jim Alpha} 20000410}}
+test cmdIL-5.4 {lsort with list style index} {
+    lsort -integer -index {1 end-1} {
+	{the {0 1 2 3 4 5} quick}
+	{brown {0 1 2 3 4} fox}
+	{jumps {30 31 2 33} over}
+	{the {0 1 2} lazy}
+	{dogs {0 1}}
+    }
+} {{dogs {0 1}} {the {0 1 2} lazy} {jumps {30 31 2 33} over} {brown {0 1 2 3 4} fox} {the {0 1 2 3 4 5} quick}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/lsearch.test b/tests/lsearch.test
index b1ab6fc..61b45f6 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: lsearch.test,v 1.11 2003/03/27 13:19:15 dkf Exp $
+# RCS: @(#) $Id: lsearch.test,v 1.12 2003/10/14 13:38:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -61,7 +61,7 @@ test lsearch-2.9 {search modes} {
 } 1
 test lsearch-2.10 {search modes} {
     list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
+} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
 
 test lsearch-3.1 {lsearch errors} {
     list [catch lsearch msg] $msg
@@ -71,13 +71,19 @@ test lsearch-3.2 {lsearch errors} {
 } {1 {wrong # args: should be "lsearch ?options? list pattern"}}
 test lsearch-3.3 {lsearch errors} {
     list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
 test lsearch-3.4 {lsearch errors} {
     list [catch {lsearch a b c d} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -inline, -integer, -not, -real, -regexp, -sorted, or -start}}
+} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -not, -real, -regexp, -sorted, -start, or -subindices}}
 test lsearch-3.5 {lsearch errors} {
     list [catch {lsearch "\{" b} msg] $msg
 } {1 {unmatched open brace in list}}
+test lsearch-3.6 {lsearch errors} {
+    list [catch {lsearch -index a b} msg] $msg
+} {1 {"-index" option must be followed by list index}}
+test lsearch-3.7 {lsearch errors} {
+    list [catch {lsearch -subindices -exact a b} msg] $msg
+} {1 {-subindices cannot be used without -index option}}
 
 test lsearch-4.1 {binary data} {
     lsearch -exact [list foo one\000two bar] bar
@@ -350,6 +356,70 @@ test lsearch-16.1 {lsearch -regexp shared object} {
     lsearch -regexp $str $str
 } 0
 
+test lsearch-17.1 {lsearch -index option, basic functionality} {
+    lsearch -index 1 {{a c} {a b} {a a}} a
+} 2
+test lsearch-17.2 {lsearch -index option, basic functionality} {
+    lsearch -index 1 -exact {{a c} {a b} {a a}} a
+} 2
+test lsearch-17.3 {lsearch -index option, basic functionality} {
+    lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* 
+} 1
+test lsearch-17.4 {lsearch -index option, basic functionality} {
+    lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
+} 0 
+test lsearch-17.5 {lsearch -index option, basic functionality} {
+    lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
+} {0 1}
+test lsearch-17.6 {lsearch -index option, basic functionality} {
+    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* 
+} {1 2}
+test lsearch-17.7 {lsearch -index option, basic functionality} {
+    lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
+} {0 1}
+
+test lsearch-18.1 {lsearch -index option, list as index basic functionality} {
+    lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} 1
+test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
+    lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} 0
+test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
+    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
+} 0
+test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
+    lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
+} 0 
+test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
+    lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
+} {0 1}
+
+test lsearch-19.1 {lsearch -sunindices option} {
+    lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} {1 0 0}
+test lsearch-19.2 {lsearch -sunindices option} {
+    lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} {0 2 0}
+test lsearch-19.3 {lsearch -sunindices option} {
+    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
+} {0 1 1}
+test lsearch-19.4 {lsearch -sunindices option} {
+    lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
+} {0 0 1} 
+test lsearch-19.5 {lsearch -sunindices option} {
+    lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
+} {{0 0 0} {1 0 0}}
+
+test lsearch-20.1 {lsearch -index option, index larger than sublists} {
+    list [catch {lsearch -index 2 {{a c} {a b} {a a}} a} msg] $msg
+} {1 {element 2 missing from sublist "a c"}}
+test lsearch-20.2 {lsearch -index option, malformed index} {
+    list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg
+} {1 {bad index "foo": must be integer or end?-integer?}}
+test lsearch-20.3 {lsearch -index option, malformed index} {
+    list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg
+} [list 1 "argument \"\{\" given to -index is invalid"]
+
 # cleanup
 catch {unset res}
 catch {unset increasingIntegers}