summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog5
-rw-r--r--doc/lsort.n8
-rw-r--r--generic/tclCmdIL.c44
-rw-r--r--tests/cmdIL.test10
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.
generated by cgit v0.12 at 2024-11-23 06:58:54 (GMT)