You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by da...@apache.org on 2002/01/09 16:55:04 UTC
cvs commit: tcl-rivet/rivet/rivet-tcl debug.tcl html.tcl incr0.tcl read_file.tcl wrap.tcl tclIndex
damonc 02/01/09 07:55:04
Modified: rivet/rivet-tcl tclIndex
Added: rivet/rivet-tcl debug.tcl html.tcl incr0.tcl read_file.tcl
wrap.tcl
Log:
Adding some new commands to the Tcl directory.
debug - A very handy command for printing debugging information.
html - A Tcl re-write of the NWS html command for printing text in HTML.
incr0 - Increment a variable. If it doesn't exist, create it.
wrap - Take a string and wrap it at X characters.
read_file - Read the contents of a file and return it.
Revision Changes Path
1.2 +6 -0 tcl-rivet/rivet/rivet-tcl/tclIndex
Index: tclIndex
===================================================================
RCS file: /home/cvs/tcl-rivet/rivet/rivet-tcl/tclIndex,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- tclIndex 8 Jan 2002 09:35:16 -0000 1.1
+++ tclIndex 9 Jan 2002 15:55:03 -0000 1.2
@@ -8,3 +8,9 @@
set auto_index(load_response) [list source [file join $dir load_response.tcl]]
set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(html) [list source [file join $dir html.tcl]]
+set auto_index(incr0) [list source [file join $dir incr0.tcl]]
+set auto_index(read_file) [list source [file join $dir read_file.tcl]]
+set auto_index(wrap) [list source [file join $dir wrap.tcl]]
+set auto_index(wrapline) [list source [file join $dir wrap.tcl]]
+set auto_index(debug) [list source [file join $dir debug.tcl]]
1.1 tcl-rivet/rivet/rivet-tcl/debug.tcl
Index: debug.tcl
===================================================================
###
## debug ?-option value? ?-option value?...
## A command to make debugging more convenient. Print strings, arrays
## and the values of variables as specified by the arguments.
##
## Also allows the setting of an array called debug which will pick up
## options for all debug commands.
##
## We create this command in the ::request namespace because we want the
## user to be able to use the debug array without actually having to set
## it at the global level.
##
## Options:
## -subst <on|off> - Each word should be considered a variable and subst'd.
## -separator <string> - A text string that goes between each variable.
## -ip <ip address> - A list of IP addresses to display to.
###
proc debug {args} {
## If they've turned off debugging, we don't do anything.
if {[info exists ::RivetUserConf(Debug)] && !$::RivetUserConf(Debug)} {
return
}
## We want to save the REMOTE_ADDR for any subsequent calls to debug.
if {![info exists ::RivetUserConf(REMOTE_ADDR)]} {
load_env
set ::RivetUserConf(REMOTE_ADDR) $env(REMOTE_ADDR)
}
## Set some defaults for the options.
set data(subst) 0
set data(separator) <br>
## Check RivetUserConf for globally set options.
if {[info exists ::RivetUserConf(DebugIp)]} {
set data(ip) $::RivetUserConf(DebugIp)
}
if {[info exists ::RivetUserConf(DebugSubst)]} {
set data(subst) $::RivetUserConf(DebugSubst)
}
if {[info exists ::RivetUserConf(DebugSeparator)]} {
set data(separator) $::RivetUserConf(DebugSeparator)
}
set looking 0
set endit 0
foreach arg $args {
if $endit {
lappend list $arg
continue
}
if $looking {
set data($varName) $arg
set looking 0
continue
}
if {[string index $arg 0] == "-"} {
if {$arg == "--"} {
set endit 1
continue
}
set varName [string range $arg 1 end]
set looking 1
continue
}
lappend list $arg
}
if {[info exists data(ip)]} {
set can_see 0
foreach ip $data(ip) {
if {[string match $data(ip)* $::RivetUserConf(REMOTE_ADDR)]} {
set can_see 1
break
}
}
if {!$can_see} { return }
}
if {[string tolower $data(subst)] != "on"} {
html [join $list]
return
}
set lastWasArray 0
foreach varName $list {
upvar $varName var
if {[array exists var]} {
parray $varName
set lastWasArray 1
} elseif {[info exists var]} {
if {!$lastWasArray} {
html $data(separator)
}
html $var
set lastWasArray 0
} else {
if {!$lastWasArray} {
html $data(separator)
}
html $varName
set lastWasArray 0
}
}
}
1.1 tcl-rivet/rivet/rivet-tcl/html.tcl
Index: html.tcl
===================================================================
###
## html <string> ?arg.. arg.. arg..?
## Print text with the added ability to pass HTML tags following the string.
## Example:
## html "Test" b i
##
## Will produce:
## <b><i>Test</i></b>
##
## string - A text string to be displayed.
## args - A list of HTML tags (without <>) to surround <string> in.
###
proc html {string args} {
foreach arg $args { append output <$arg> }
append output $string
for {set i [expr [llength $args] - 1]} {$i >= 0} {incr i -1} {
append output </[lindex [lindex $args $i] 0]>
}
puts $output
}
1.1 tcl-rivet/rivet/rivet-tcl/incr0.tcl
Index: incr0.tcl
===================================================================
###
## incr0 ?varName? ?num?
## Increment a variable by <num>. If the variable doesn't exist, create
## it instead of returning an error.
##
## varName - Name of the variable to increment.
## num - Number to increment by.
###
proc incr0 {varName {num 1}} {
upvar 1 $varName var
if {![info exists var]} { set var 0 }
return [incr var $num]
}
1.1 tcl-rivet/rivet/rivet-tcl/read_file.tcl
Index: read_file.tcl
===================================================================
###
## read_file <file>
## Read the entire contents of a file and return it as a string.
##
## file - Name of the file to read.
###
proc read_file {file} {
set fp [open $file]
set x [read $fp]
close $fp
return $x
}
1.1 tcl-rivet/rivet/rivet-tcl/wrap.tcl
Index: wrap.tcl
===================================================================
proc wrap {string maxlen {html ""}} {
set splitstring {}
foreach line [split $string "\n"] {
lappend splitstring [wrapline $line $maxlen $html]
}
if {$html == "-html"} {
return [join $splitstring "<br>"]
} else {
return [join $splitstring "\n"]
}
}
proc wrapline {line maxlen {html ""}} {
set string [split $line " "]
set newline [list [lindex $string 0]]
foreach word [lrange $string 1 end] {
if {[string length $newline]+[string length $word] > $maxlen} {
lappend lines [join $newline " "]
set newline {}
}
lappend newline $word
}
lappend lines [join $newline " "]
if {$html == "-html"} {
return [join $lines <br>]
} else {
return [join $lines "\n"]
}
}