TIP#217 implementation

4 files changed, 52 insertions, 15 deletions

diff --git a/ChangeLog b/ChangeLog
index c3b855c..0e5e72b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2004-10-14  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
+	TIP#217 IMPLEMENTATION
+
+	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Add -indices option from
+	James Salsman. [Patch 1017532]
+
 	* generic/tclUtil.c (TclMatchIsTrivial): Detect degenerate cases
 	of glob matching that let us avoid scanning through hash tables.
 	* generic/tclCmdIL.c (InfoCommandsCmd, InfoGlobalsCmd, InfoProcsCmd):
diff --git a/doc/lsort.n b/doc/lsort.n
index 3763ee6..9e29db3 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.16 2004/08/31 15:19:36 dkf Exp $
+'\" RCS: @(#) $Id: lsort.n,v 1.17 2004/10/14 17:20:11 dkf Exp $
 '\" 
 .so man.macros
 .TH lsort n 8.3 Tcl "Tcl Built-In Commands"
@@ -65,6 +65,12 @@ This is the default.
 \fB\-decreasing\fR
 Sort the list in decreasing order (``largest'' items first).
 .TP 20
+\fB\-indices\fR
+.VS "8.5 (TIP#217)"
+Return a list of indices into \fIlist\fR in sorted order instead of
+the values themselves.
+.VE "8.5 (TIP#217)"
+.TP 20
 \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
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 2997509..2204d1f 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.65 2004/10/14 15:06:01 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.66 2004/10/14 17:20:11 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -3751,7 +3751,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
     int objc;			/* Number of arguments. */
     Tcl_Obj *CONST objv[];	/* Argument values. */
 {
-    int i, index, unique;
+    int i, index, unique, indices;
     Tcl_Obj *resultPtr;
     int length;
     Tcl_Obj *cmdPtr, **listObjPtrs;
@@ -3762,12 +3762,12 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 					 * comparison function */
     static CONST char *switches[] = {
 	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
-	"-index", "-integer", "-real", "-unique", (char *) NULL
+	"-index", "-indices", "-integer", "-real", "-unique", (char *) NULL
     };
     enum Lsort_Switches {
 	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
-	LSORT_INCREASING, LSORT_INDEX, LSORT_INTEGER, LSORT_REAL,
-	LSORT_UNIQUE
+	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
+	LSORT_REAL, LSORT_UNIQUE
     };
 
     if (objc < 2) {
@@ -3787,6 +3787,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
     sortInfo.resultCode = TCL_OK;
     cmdPtr = NULL;
     unique = 0;
+    indices = 0;
     for (i = 1; i < objc-1; i++) {
 	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
 		!= TCL_OK) {
@@ -3884,6 +3885,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
 	case LSORT_UNIQUE:
 	    unique = 1;
 	    break;
+	case LSORT_INDICES:
+	    indices = 1;
+	    break;
 	}
     }
 
@@ -3928,16 +3932,32 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
     if (sortInfo.resultCode == TCL_OK) {
 	resultPtr = Tcl_NewObj();
 	if (unique) {
-	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
-		if (elementPtr->count == 0) {
-		    Tcl_ListObjAppendElement(interp, resultPtr,
-			    elementPtr->objPtr);
+	    if (indices) {
+		for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
+		    if (elementPtr->count == 0) {
+			Tcl_ListObjAppendElement(interp, resultPtr,
+				Tcl_NewIntObj(elementPtr - &elementArray[0]));
+		    }
+		}
+	    } else {
+		for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr) {
+		    if (elementPtr->count == 0) {
+			Tcl_ListObjAppendElement(interp, resultPtr,
+				elementPtr->objPtr);
+		    }
 		}
 	    }
 	} else {
-	    for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
-		Tcl_ListObjAppendElement(interp, resultPtr,
-			elementPtr->objPtr);
+	    if (indices) {
+		for (; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
+		    Tcl_ListObjAppendElement(interp, resultPtr,
+			    Tcl_NewIntObj(elementPtr - &elementArray[0]));
+		}
+	    } else {
+		for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+		    Tcl_ListObjAppendElement(interp, resultPtr,
+			    elementPtr->objPtr);
+		}
 	    }
 	}
 	Tcl_SetObjResult(interp, resultPtr);
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index e9b1432..156c4dd 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.22 2004/01/18 16:19:06 dkf Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.23 2004/10/14 17:20:11 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -23,7 +23,7 @@ test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
 } {1 {wrong # args: should be "lsort ?options? list"}}
 test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
     list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -integer, -real, or -unique}}
+} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -real, or -unique}}
 test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
     lsort {d e c b a \{ d35 d300}
 } {a b c d d300 d35 e \{}
@@ -112,6 +112,12 @@ test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup
 test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
     lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
 } {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
+test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} {
+    lsort -indices {a c b}
+} {0 2 1}
+test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} {
+    lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6}
+} {2 3 0}
 
 # Can't think of any good tests for the MergeSort and MergeLists
 # procedures, except a bunch of random lists to sort.