Attachment "481022.diff" to
ticket [481022ffff]
added by
andreas_kupries
2001-11-24 09:23:12.
? modules/fileinput
? modules/ftp/test_ftpchan.tcl
? modules/ftp/example
? modules/ftpd/examples
Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.87
diff -u -r1.87 ChangeLog
--- ChangeLog 2001/11/19 23:32:48 1.87
+++ ChangeLog 2001/11/24 02:21:34
@@ -1,3 +1,7 @@
+2001-11-23 Andreas Kupries <[email protected]>
+
+ * struct.matrix: Implemented FR #481022.
+
2001-11-19 Andreas Kupries <[email protected]>
* struct/graph: Applied patch #483125
Index: modules/struct/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/ChangeLog,v
retrieving revision 1.17
diff -u -r1.17 ChangeLog
--- modules/struct/ChangeLog 2001/11/19 23:32:48 1.17
+++ modules/struct/ChangeLog 2001/11/24 02:21:36
@@ -1,3 +1,10 @@
+2001-11-23 Andreas Kupries <[email protected]>
+
+ * matrix.test:
+ * matrix.n:
+ * matrix.tcl: Implementation of FR #481022: matrix printing and
+ searching.
+
2001-11-19 Andreas Kupries <[email protected]>
* graph.test:
Index: modules/struct/matrix.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/matrix.n,v
retrieving revision 1.6
diff -u -r1.6 matrix.n
--- modules/struct/matrix.n 2001/10/17 17:27:26 1.6
+++ modules/struct/matrix.n 2001/11/24 02:21:36
@@ -105,15 +105,20 @@
Destroys the matrix, including its storage space and associated
command.
.TP
-\fImatrixName \fBformat 2string\fR \fIreport\fR
+\fImatrixName \fBformat 2string\fR ?\fIreport\fR?
Formats the matrix using the specified report object and returns the
string containing the result of this operation. The report has to
-support the \fBprintmatrix\fR method.
+support the \fBprintmatrix\fR method. If no \fIreport\fR is specified
+the system will use an internal report definition to format the
+matrix.
.TP
-\fImatrixName \fBformat 2chan\fR \fIreport channel\fR
+\fImatrixName \fBformat 2chan\fR ??\fIreport\fR? \fIchannel\fR?
Formats the matrix using the specified report object and writes the
string containing the result of this operation into the channel. The
-report has to support the \fBprintmatrix2channel\fR method.
+report has to support the \fBprintmatrix2channel\fR method. If no
+\fIreport\fR is specified the system will use an internal report
+definition to format the matrix. If no \fIchannel\fR is specified the
+system will use \fBstdout\fR.
.TP
\fImatrixName\fR \fBget cell\fR \fIcolumn row\fR
Returns the value currently contained in the cell identified by row
@@ -182,6 +187,31 @@
.TP
\fImatrixName\fR \fBrows\fR
Returns the number of rows currently managed by the matrix.
+.TP
+\fImatrixName\fR \fBsearch\fR ?-exact|-glob|-regexp? \fBall\fR \fIpattern\fR
+Searches the whole matrix for cells matching the \fIpattern\fR and
+returns a list with all matches. Each item in the aforementioned list
+is a list itself and contains the column and row index of the matching
+cell, in this order. The results are ordered by column first and row
+second, both times in ascending order. This means that matches to the
+left and the top of the matrix come before matches to the right and
+down.
+.sp
+The type of the pattern (string, glob, regular expression) is
+determined by the option after the \fBsearch\fR keyword. If no option
+is given it defaults to \fB-exact\fR.
+.TP
+\fImatrixName\fR \fBsearch\fR ?-exact|-glob|-regexp? \fBcolumn\fR \fIcolumn pattern\fR
+Like \fBsearch all\fR, but the search is restricted to the specified
+column.
+.TP
+\fImatrixName\fR \fBsearch\fR ?-exact|-glob|-regexp? \fBrow\fR \fIrow pattern\fR
+Like \fBsearch all\fR, but the search is restricted to the specified
+row.
+.TP
+\fImatrixName\fR \fBsearch\fR ?-exact|-glob|-regexp? \fBrect\fR \fIcolumn_tl row_tl column_br row_br pattern\fR
+Like \fBsearch all\fR, but the search is restricted to the specified
+rectangular area of the matrix.
.TP
\fImatrixName\fR \fBset cell\fR \fIcolumn row value\fR
Sets the value in the cell identified by row and column index to the
Index: modules/struct/matrix.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/matrix.tcl,v
retrieving revision 1.3
diff -u -r1.3 matrix.tcl
--- modules/struct/matrix.tcl 2001/07/10 20:39:47 1.3
+++ modules/struct/matrix.tcl 2001/11/24 02:21:36
@@ -48,6 +48,7 @@
"link" \
"rowheight" \
"rows" \
+ "search" \
"set" \
"swap" \
"unlink"
@@ -282,6 +283,106 @@
eval [list ::struct::matrix::__insert_$cmd $name] $args
}
+# ::struct::matrix::_search --
+#
+# Command that processes all 'search' subcommands.
+#
+# Arguments:
+# name Name of the matrix object to manipulate.
+# args Arguments for search.
+#
+# Results:
+# Varies based on command to perform
+
+proc ::struct::matrix::_search {name args} {
+ # Possible argument signatures
+ #
+ # \ | args
+ # --+--------------------------------------------------------
+ # 2 | all pattern
+ # 3 | option all pattern, row row pattern, column col pattern
+ # 4 | option row row pattern, option colun col pattern
+ # 6 | rect ctl rtl cbr rbr pattern
+ # 7 | option rect ctl rtl cbr rbr pattern
+ #
+ # All range specifications are internally converted into a
+ # rectangle.
+
+ switch -exact -- [llength $args] {
+ 2 - 3 - 4 - 6 - 7 {}
+ default {
+ return -code error \
+ "wrong # args: should be \"$name search ?option? (row row|column col|rect c r c r) pattern\""
+ }
+ }
+ switch -glob -- [lindex $args 0] {
+ -exact - -glob - -regexp {
+ set mode [string range [lindex $args 0] 1 end]
+ set args [lrange $args 1 end]
+ }
+ -* {
+ return -code error "invalid pattern option \"[lindex $args 0]\""
+ }
+ default {
+ set mode exact
+ }
+ }
+
+ set range [lindex $args 0]
+ set pattern [lindex $args end]
+ set args [lrange $args 1 end-1]
+
+ upvar ::struct::matrix::matrix${name}::data data
+ upvar ::struct::matrix::matrix${name}::columns cols
+ upvar ::struct::matrix::matrix${name}::rows rows
+
+ switch -exact -- $range {
+ all {
+ set ctl 0 ; set cbr $cols ; incr cbr -1
+ set rtl 0 ; set rbr $rows ; incr rbr -1
+ }
+ column {
+ set ctl [ChkColumnIndex $name [lindex $args 0]]
+ set cbr $ctl
+ set rtl 0 ; set rbr $rows ; incr rbr -1
+ }
+ row {
+ set rtl [ChkRowIndex $name [lindex $args 0]]
+ set ctl 0 ; set cbr $cols ; incr cbr -1
+ set rbr $rtl
+ }
+ rect {
+ foreach {ctl rtl cbr rbr} $args break
+ set ctl [ChkColumnIndex $name $ctl]
+ set rtl [ChkRowIndex $name $rtl]
+ set cbr [ChkColumnIndex $name $cbr]
+ set rbr [ChkRowIndex $name $rbr]
+ if {($ctl > $cbr) || ($rtl > $rbr)} {
+ return -code error "Invalid cell indices, wrong ordering"
+ }
+ }
+ default {
+ return -code error "invalid range spec \"$range\""
+ }
+ }
+
+ set matches [list]
+ for {set r $rtl} {$r <= $rbr} {incr r} {
+ for {set c $ctl} {$c <= $cbr} {incr c} {
+ set v $data($c,$r)
+ switch -exact -- $mode {
+ exact {set matched [string equal $pattern $v]}
+ glob {set matched [string match $pattern $v]}
+ regexp {set matched [regexp $pattern $v]}
+ }
+ if {$matched} {
+ lappend matches [list $c $r]
+ }
+ }
+ }
+ return $matches
+}
+
# ::struct::matrix::_set --
#
# Command that processes all 'set' subcommands.
@@ -735,9 +836,48 @@
#
# Results:
# A string containing the formatting result.
+
+proc ::struct::matrix::__format_2string {name {report {}}} {
+ if {$report == {}} {
+ # Use an internal hardwired simple report to format the matrix.
+ # 1. Go through all columns and compute the column widths.
+ # 2. Then iterate through all rows and dump then into a
+ # string, formatted to the number of characters per columns
+
+ array set cw {}
+ set cols [_columns $name]
+ for {set c 0} {$c < $cols} {incr c} {
+ set cw($c) [_columnwidth $name $c]
+ }
-proc ::struct::matrix::__format_2string {name report} {
- return [$report printmatrix $name]
+ set result [list]
+ set n [_rows $name]
+ for {set r 0} {$r < $n} {incr r} {
+ set rh [_rowheight $name $r]
+ if {$rh < 2} {
+ # Simple row.
+ set line [list]
+ for {set c 0} {$c < $cols} {incr c} {
+ set val [__get_cell $name $c $r]
+ lappend line "$val[string repeat " " [expr {$cw($c)-[string length $val]}]]"
+ }
+ lappend result [join $line " "]
+ } else {
+ # Complex row, multiple passes
+ for {set h 0} {$h < $rh} {incr h} {
+ set line [list]
+ for {set c 0} {$c < $cols} {incr c} {
+ set val [lindex [split [__get_cell $name $c $r] \n] $h]
+ lappend line "$val[string repeat " " [expr {$cw($c)-[string length $val]}]]"
+ }
+ lappend result [join $line " "]
+ }
+ }
+ }
+ return [join $result \n]
+ } else {
+ return [$report printmatrix $name]
+ }
}
# ::struct::matrix::__format_2chan --
@@ -755,8 +895,14 @@
# Results:
# None.
-proc ::struct::matrix::__format_2chan {name report chan} {
- $report printmatrix2channel $name $chan
+proc ::struct::matrix::__format_2chan {name {report {}} {chan stdout}} {
+ if {$report == {}} {
+ # Use an internal hardwired simple report to format the matrix.
+ # We delegate this to the string formatter and print its result.
+ puts -nonewline [__format_2string $name]
+ } else {
+ $report printmatrix2channel $name $chan
+ }
return
}
@@ -1141,7 +1287,6 @@
set rh($row) $height
}
-
return $rh($row)
}
Index: modules/struct/matrix.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/struct/matrix.test,v
retrieving revision 1.2
diff -u -r1.2 matrix.test
--- modules/struct/matrix.test 2001/05/20 11:22:09 1.2
+++ modules/struct/matrix.test 2001/11/24 02:21:36
@@ -80,7 +80,7 @@
catch {mymatrix foo} msg
mymatrix destroy
set msg
-} "bad option \"foo\": must be add, cells, cellsize, columns, columnwidth, delete, destroy, format, get, insert, link, rowheight, rows, set, swap, or unlink"
+} "bad option \"foo\": must be add, cells, cellsize, columns, columnwidth, delete, destroy, format, get, insert, link, rowheight, rows, search, set, swap, or unlink"
test matrix-0.4 {matrix errors} {
matrix mymatrix
@@ -454,11 +454,37 @@
mymatrix add columns 3
mymatrix set rect 0 0 {{1 2 5} {3 4 6} {7 8 9}}"
+test matrix-5.2 {internal format} {
+ matrix mymatrix
+ mymatrix add column
+ mymatrix add row {1}
+ mymatrix add column {2}
+ mymatrix add row {3 4}
+ mymatrix add column {5 6}
+ mymatrix add row {7 8 9}
+ set result [mymatrix format 2string]
+ mymatrix destroy
+ set result
+} "1 2 5\n3 4 6\n7 8 9"
+
+test matrix-5.3 {internal format} {
+ matrix mymatrix
+ mymatrix add column
+ mymatrix add row {1}
+ mymatrix add column {2}
+ mymatrix add row {3a 4}
+ mymatrix add column {5 6}
+ mymatrix add row [list 7 8 "9\nb"]
+ set result [mymatrix format 2string]
+ mymatrix destroy
+ set result
+} "1 2 5\n3a 4 6\n7 8 9\n b"
+
if {![catch {package require memchan}]} {
# We have memory channels and can therefore test
# 'format2channel-via' too.
- test matrix-5.2 {formatting} {
+ test matrix-5.4 {formatting} {
matrix mymatrix
mymatrix add column
mymatrix add row {1}
@@ -1375,6 +1401,36 @@
mymatrix destroy
set result
} {can't set "a(1,5)": bad row index 5, row does not exist}
+
+
+foreach {n mode range pattern result} {
+ 0 -exact {all} {ab} {{0 3}}
+ 1 -glob {all} {a*} {{0 2} {0 3}}
+ 2 -regexp {all} {b.} {{1 3}}
+ 3 -exact {row 2} {b} {{1 2}}
+ 4 -glob {row 3} {b*} {{1 3}}
+ 5 -regexp {row 4} {d} {{0 4} {1 4}}
+ 6 -exact {column 2} {c} {{2 2}}
+ 7 -glob {column 0} {a*} {{0 2} {0 3}}
+ 8 -regexp {column 1} {b.*} {{1 2} {1 3}}
+ 9 -exact {rect 1 1 3 3} {c} {{2 2}}
+ 10 -glob {rect 1 1 3 3} {b*} {{1 2} {1 3}}
+ 11 -regexp {rect 1 1 3 3} {b.*} {{1 2} {1 3}}
+} {
+ test matrix-10.$n "searching ($mode $range $pattern)" {
+ matrix mymatrix
+ mymatrix add columns 5
+ mymatrix add row {1 2 3 4 5}
+ mymatrix add row {6 7 8 9 0}
+ mymatrix add row {a b c d e}
+ mymatrix add row {ab ba f g h}
+ mymatrix add row {cd 4d x y z}
+ set result [eval mymatrix search $mode $range $pattern]
+ mymatrix destroy
+ set result
+ } $result ; # {}
+}
+
::tcltest::cleanupTests
