summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorhobbs <hobbs>2005-09-29 23:16:29 (GMT)
committerhobbs <hobbs>2005-09-29 23:16:29 (GMT)
commit33d8a64399b54b08c5bd702183b92c4c9548e156 (patch)
treeefa0c5c468fdb7622cbd1b156b88e24c1700ae46 /library
parent3eb8e1f8c787fcdebda1ee637b8d1710cac1c04f (diff)
downloadtcl-33d8a64399b54b08c5bd702183b92c4c9548e156.zip
tcl-33d8a64399b54b08c5bd702183b92c4c9548e156.tar.gz
tcl-33d8a64399b54b08c5bd702183b92c4c9548e156.tar.bz2
implementation for TIP #255, expr min/max
Diffstat (limited to 'library')
-rw-r--r--library/init.tcl44
1 files changed, 43 insertions, 1 deletions
diff --git a/library/init.tcl b/library/init.tcl
index bd04e08..9551a1c 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.81 2005/09/14 17:13:18 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.82 2005/09/29 23:16:29 hobbs Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -95,6 +95,48 @@ namespace eval tcl {
truncate ::tcl::chan::Truncate
}
}
+
+ # TIP #255 min and max functions
+ namespace eval mathfunc {
+ proc min {args} {
+ if {[llength $args] == 0} {
+ return -code error \
+ "too few arguments to math function \"min\""
+ }
+ set val [lindex $args 0]
+ # This will handle forcing the numeric value without
+ # ruining the interval type of a numeric object
+ if {[catch {expr {double($val)}} err]} {
+ return -code error $err
+ }
+ foreach arg [lrange $args 1 end] {
+ if {[catch {expr {double($arg)}} err]} {
+ return -code error $err
+ }
+ if {$arg < $val} { set val $arg }
+ }
+ return $val
+ }
+ proc max {args} {
+ if {[llength $args] == 0} {
+ return -code error \
+ "too few arguments to math function \"max\""
+ }
+ set val [lindex $args 0]
+ # This will handle forcing the numeric value without
+ # ruining the interval type of a numeric object
+ if {[catch {expr {double($val)}} err]} {
+ return -code error $err
+ }
+ foreach arg [lrange $args 1 end] {
+ if {[catch {expr {double($arg)}} err]} {
+ return -code error $err
+ }
+ if {$arg > $val} { set val $arg }
+ }
+ return $val
+ }
+ }
}
# Windows specific end of initialization