Revision: 42357
http://brlcad.svn.sourceforge.net/brlcad/?rev=42357&view=rev
Author: starseeker
Date: 2011-01-17 05:23:20 +0000 (Mon, 17 Jan 2011)
Log Message:
-----------
Start merging in changes from latest cvs incrTcl - will try to do this
carefully, as there are a few changes that will need to be preserved.
Modified Paths:
--------------
brlcad/trunk/src/other/incrTcl/itcl/tests/basic.test
brlcad/trunk/src/other/incrTcl/itcl/tests/methods.test
brlcad/trunk/src/other/incrTcl/itcl/tests/old/all
brlcad/trunk/src/other/incrTcl/license.terms
brlcad/trunk/src/other/incrTcl/tools/genStubs.tcl
Added Paths:
-----------
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Appliance.tcl
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Hazard.tcl
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Outlet.tcl
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/SmartToaster.tcl
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Toaster.tcl
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/tclIndex
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/usualway.tcl
Modified: brlcad/trunk/src/other/incrTcl/itcl/tests/basic.test
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/basic.test 2011-01-17
04:53:26 UTC (rev 42356)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/basic.test 2011-01-17
05:23:20 UTC (rev 42357)
@@ -20,6 +20,10 @@
::tcltest::loadTestedCommands
+test basic-1.0 {empty string as class name should fail but not crash} {
+ list [catch {itcl::class "" {}} err] $err
+} {1 {invalid class name ""}}
+
# ----------------------------------------------------------------------
# Simple class definition
# ----------------------------------------------------------------------
@@ -106,22 +110,30 @@
itcl::is class [itcl::code Counter]
} {1}
-test basic-1.14 {is command with class argument (class does not exist)} {
+test basic-1.15 {is command with class argument (class does not exist)} {
itcl::is class Count
} {0}
-test basic-1.15 {is command with object argument} {
+test basic-1.16 {is command with object argument} {
itcl::is object -foo
} {1}
-test basic-1.16 {is command with object argument (object does not exist)} {
+test basic-1.17 {is command with object argument (object does not exist)} {
itcl::is object xxx
} {0}
-test basic-1.15 {is command with object argument (with code command)} {
+test basic-1.18 {is command with object argument (with code command)} {
itcl::is object [itcl::code -- -foo]
} {1}
+test basic-1.19 {classes can be unicode} {
+ itcl::class \u6210bcd { method foo args { return "bar" } }
+ \u6210bcd #auto
+} \u6210bcd0
+test basic-1.20 {classes can be unicode} {
+ \u6210bcd0 foo
+} bar
+
# ----------------------------------------------------------------------
# #auto names
# ----------------------------------------------------------------------
@@ -142,6 +154,36 @@
Counter #auto
} {counter4}
+test basic-2.5 {"#auto" with :: at front of name} {
+ itcl::class AutoCheck {}
+ set result [AutoCheck ::#auto]
+ rename AutoCheck {}
+ set result
+} {::autoCheck0}
+
+test basic-2.6 {"#auto" with :: at front of name inside method} {
+ itcl::class AutoCheck {
+ proc new {} {
+ return [AutoCheck ::#auto]
+ }
+ }
+ set result [AutoCheck::new]
+ rename AutoCheck {}
+ set result
+} {::autoCheck0}
+
+test basic-2.7 {"#auto" with :: at front of name inside method inside
namespace} {
+ namespace eval AutoCheckNs {}
+ itcl::class AutoCheckNs::AutoCheck {
+ proc new {} {
+ return [AutoCheckNs::AutoCheck ::#auto]
+ }
+ }
+ set result [AutoCheckNs::AutoCheck::new]
+ namespace delete AutoCheckNs
+ set result
+} {::autoCheck0}
+
# ----------------------------------------------------------------------
# Simple object use
# ----------------------------------------------------------------------
Modified: brlcad/trunk/src/other/incrTcl/itcl/tests/methods.test
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/methods.test 2011-01-17
04:53:26 UTC (rev 42356)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/methods.test 2011-01-17
05:23:20 UTC (rev 42357)
@@ -147,6 +147,17 @@
[ta info variable boom -value]
} {0 {crash_time: a b c} ok no-problem}
+test methods-2.1 {covers leak condition test for compiled locals, no args} {
+ for {set i 0} {$i < 100} {incr i} {
+ ::itcl::class LeakClass {
+ proc leakProc {} { set n 1 }
+ }
+ LeakClass::leakProc
+ ::itcl::delete class LeakClass
+ }
+ list 0
+} 0
+
# ----------------------------------------------------------------------
# Clean up
# ----------------------------------------------------------------------
Modified: brlcad/trunk/src/other/incrTcl/itcl/tests/old/all
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/all 2011-01-17 04:53:26 UTC
(rev 42356)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/all 2011-01-17 05:23:20 UTC
(rev 42357)
@@ -6,7 +6,7 @@
# [email protected]
# http://www.tcltk.com/itcl
#
-# RCS: $Id: all,v 14.2 2007-10-24 20:30:26 erikgreenwald Exp $
+# RCS: $Id: all,v 1.1 1998/07/27 18:41:24 stanton Exp $
# ----------------------------------------------------------------------
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
# ======================================================================
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Appliance.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Appliance.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Appliance.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,43 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Base class for all electrical appliances that interact
+# with Outlets.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: Appliance.tcl,v 1.1 1998/07/27 18:41:29 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Appliance {
+
+ method power {power} {
+ if {[itcl_info objects [info which $outlet]] == ""} {
+ set outlet {}
+ }
+ if {$outlet == ""} {
+ error "cannot use $this: not plugged in"
+ }
+ $outlet use $power
+ }
+
+ public outlet {}
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Appliance.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Hazard.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Hazard.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Hazard.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,78 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Tracking for hazardous products manufactured by the
+# "toaster" company.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: Hazard.tcl,v 1.1 1998/07/27 18:41:30 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class HazardRec {
+ constructor {cname} {
+ set class $cname
+ }
+ method change {var inc} {
+ if {![info exists $var]} {
+ error "bad field \"$var\""
+ }
+ incr $var $inc
+ }
+ method report {} {
+ return "$class: $total produced, $actives active, $accidents
accidents"
+ }
+ protected class {}
+ protected total 0
+ protected actives 0
+ protected accidents 0
+}
+
+itcl_class Hazard {
+
+ constructor {} {
+ set class [virtual info class]
+ if {![info exists recs($class)]} {
+ set recs($class) [HazardRec #auto $class]
+ }
+ $recs($class) change total +1
+ $recs($class) change actives +1
+ }
+ destructor {
+ set class [virtual info class]
+ $recs($class) change actives -1
+ }
+
+ method accident {mesg} {
+ set class [virtual info class]
+ $recs($class) change accidents +1
+ puts stderr $mesg
+ }
+
+ proc report {class} {
+ if {[info exists recs($class)]} {
+ return [$recs($class) report]
+ } else {
+ error "no information for class \"$class\""
+ }
+ }
+ common recs
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Hazard.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Outlet.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Outlet.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Outlet.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,81 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Electrical outlet supplying power for Appliances.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: Outlet.tcl,v 1.1 1998/07/27 18:41:30 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Outlet {
+ constructor {config} {}
+ method config {config} {}
+
+ destructor {
+ if {$usage > 0} bill
+ }
+
+ method use {power} {
+ set usage [expr $usage+$power]
+ }
+
+ method sendBill {} {
+ if {[catch "open /tmp/bill w" fout] != 0} {
+ error "cannot create bill in /tmp"
+ } else {
+ set amount [format "$%.2f" [expr $usage*$rate]]
+ puts $fout "----------------------------------------"
+ puts $fout "/////////// MEGA-POWER, INC. ///////////"
+ puts $fout "----------------------------------------"
+ puts $fout " Customer: $owner"
+ puts $fout " Outlet: $this"
+ puts $fout " Usage: $usage kilowatt-hours"
+ puts $fout " "
+ puts $fout " Amount Due: $amount"
+ puts $fout "----------------------------------------"
+ close $fout
+ exec mail $owner < /tmp/bill
+ set usage 0
+ }
+ }
+
+ proc bill {{customer *}} {
+ foreach outlet [itcl_info objects -class Outlet] {
+ set owner [$outlet info public owner -value]
+ if {[string match $customer $owner]} {
+ $outlet sendBill
+ }
+ }
+ }
+
+ proc rate {{newval ""}} {
+ if {$newval == ""} {
+ return $rate
+ }
+ set rate $newval
+ }
+
+ public owner {}
+ protected usage 0
+
+ common rate 0.05
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Outlet.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/SmartToaster.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/SmartToaster.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/SmartToaster.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,40 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Class definition for handling "smart" toasters via
+# [incr Tcl]. A "smart" toaster is a toaster that
+# automatically cleans itself when the crumb tray is full.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: SmartToaster.tcl,v 1.1 1998/07/27 18:41:31 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class SmartToaster {
+ inherit Toaster
+
+ method toast {nslices} {
+ if {$crumbs >= [expr $maxcrumbs-10]} {
+ clean
+ }
+ return [Toaster::toast $nslices]
+ }
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/SmartToaster.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Toaster.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Toaster.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Toaster.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,75 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Class definition for handling toasters via [incr Tcl].
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: Toaster.tcl,v 1.1 1998/07/27 18:41:31 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Toaster {
+ inherit Appliance Hazard
+
+ constructor {config} {}
+ destructor {
+ if {$crumbs > 0} {
+ puts stdout "$crumbs crumbs ... what a mess!"
+ }
+ }
+ method config {config} {}
+
+ method toast {nslices} {
+ power [expr 0.03*$heat]
+ if {$nslices < 1 || $nslices > 2} {
+ error "bad number of slices: should be 1 or 2"
+ }
+ set crumbs [expr $crumbs+$heat*$nslices]
+ if {$crumbs >= $maxcrumbs} {
+ accident "== FIRE! FIRE! =="
+ set crumbs $maxcrumbs
+ }
+ return [check]
+ }
+
+ method clean {} {
+ power 0.5
+ set crumbs 0
+ return [check]
+ }
+
+ method check {} {
+ set level [expr $crumbs*100.0/$maxcrumbs]
+ return [format "crumb tray: %.0f%% full" $level]
+ }
+
+ proc resize {newsize} {
+ set maxcrumbs $newsize
+ }
+
+ public heat 3 {
+ if {$heat < 1 || $heat > 5} {
+ error "invalid setting $heat: should be 1-5"
+ }
+ }
+ protected crumbs 0
+ common maxcrumbs 40
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/Toaster.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/tclIndex
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/tclIndex
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/tclIndex
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,18 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(Appliance) "source $dir/Appliance.tcl"
+set auto_index(HazardRec) "source $dir/Hazard.tcl"
+set auto_index(Hazard) "source $dir/Hazard.tcl"
+set auto_index(Outlet) "source $dir/Outlet.tcl"
+set auto_index(SmartToaster) "source $dir/SmartToaster.tcl"
+set auto_index(Toaster) "source $dir/Toaster.tcl"
+set auto_index(make_toaster) "source $dir/usualway.tcl"
+set auto_index(toast_bread) "source $dir/usualway.tcl"
+set auto_index(clean_toaster) "source $dir/usualway.tcl"
+set auto_index(destroy_toaster) "source $dir/usualway.tcl"
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/tclIndex
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Added: brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/usualway.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/usualway.tcl
(rev 0)
+++ brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/usualway.tcl
2011-01-17 05:23:20 UTC (rev 42357)
@@ -0,0 +1,122 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Procedures for managing toasters in the usual
+# procedure-oriented Tcl programming style. These
+# routines illustrate data sharing through global
+# variables and naming conventions to logically group
+# related procedures. The same programming task can
+# be accomplished much more cleanly with [incr Tcl].
+# Inheritance also allows new behavior to be "mixed-in"
+# more cleanly (see Appliance and Product base classes).
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: [email protected]
+#
+# RCS: $Id: usualway.tcl,v 1.1 1998/07/27 18:41:32 stanton Exp $
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+# ----------------------------------------------------------------------
+# COMMAND: make_toaster <name> <heat>
+#
+# INPUTS
+# <name> = name of new toaster
+# <heat> = heat setting (1-5)
+#
+# RETURNS
+# name of new toaster
+#
+# SIDE-EFFECTS
+# Creates a record of a new toaster with the given heat setting
+# and an empty crumb tray.
+# ----------------------------------------------------------------------
+proc make_toaster {name heat} {
+ global allToasters
+
+ if {$heat < 1 || $heat > 5} {
+ error "invalid heat setting: should be 1-5"
+ }
+ set allToasters($name-heat) $heat
+ set allToasters($name-crumbs) 0
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: toast_bread <name> <slices>
+#
+# INPUTS
+# <name> = name of toaster used to toast bread
+# <slices> = number of bread slices (1 or 2)
+#
+# RETURNS
+# current crumb count
+#
+# SIDE-EFFECTS
+# Toasts bread and adds crumbs to crumb tray.
+# ----------------------------------------------------------------------
+proc toast_bread {name slices} {
+ global allToasters
+
+ if {[info exists allToasters($name-crumbs)]} {
+ set c $allToasters($name-crumbs)
+ set c [expr $c+$allToasters($name-heat)*$slices]
+ set allToasters($name-crumbs) $c
+ } else {
+ error "not a toaster: $name"
+ }
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: clean_toaster <name>
+#
+# INPUTS
+# <name> = name of toaster to be cleaned
+#
+# RETURNS
+# current crumb count
+#
+# SIDE-EFFECTS
+# Cleans toaster by emptying crumb tray.
+# ----------------------------------------------------------------------
+proc clean_toaster {name} {
+ global allToasters
+ set allToasters($name-crumbs) 0
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: destroy_toaster <name>
+#
+# INPUTS
+# <name> = name of toaster to be destroyed
+#
+# RETURNS
+# nothing
+#
+# SIDE-EFFECTS
+# Spills all crumbs in the toaster and then destroys it.
+# ----------------------------------------------------------------------
+proc destroy_toaster {name} {
+ global allToasters
+
+ if {[info exists allToasters($name-crumbs)]} {
+ puts stdout "$allToasters($name-crumbs) crumbs ... what a mess!"
+ unset allToasters($name-heat)
+ unset allToasters($name-crumbs)
+ }
+}
Property changes on:
brlcad/trunk/src/other/incrTcl/itcl/tests/old/toasters/usualway.tcl
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Modified: brlcad/trunk/src/other/incrTcl/license.terms
===================================================================
--- brlcad/trunk/src/other/incrTcl/license.terms 2011-01-17 04:53:26 UTC
(rev 42356)
+++ brlcad/trunk/src/other/incrTcl/license.terms 2011-01-17 05:23:20 UTC
(rev 42357)
@@ -27,7 +27,7 @@
GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
-in the software and related documentation as defined in the Federal
+in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
@@ -35,7 +35,7 @@
252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
-terms specified in this license.
+terms specified in this license.
-----------------------------------------------------------------------
Following is the original agreement for the Tcl/Tk software from
@@ -72,7 +72,7 @@
GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
-in the software and related documentation as defined in the Federal
+in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
@@ -80,4 +80,4 @@
252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
-terms specified in this license.
+terms specified in this license.
Modified: brlcad/trunk/src/other/incrTcl/tools/genStubs.tcl
===================================================================
--- brlcad/trunk/src/other/incrTcl/tools/genStubs.tcl 2011-01-17 04:53:26 UTC
(rev 42356)
+++ brlcad/trunk/src/other/incrTcl/tools/genStubs.tcl 2011-01-17 05:23:20 UTC
(rev 42357)
@@ -1,13 +1,13 @@
# genStubs.tcl --
#
# This script generates a set of stub files for a given
-# interface.
+# interface.
+#
#
-#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
+#
# RCS: @(#) $Id$
package require Tcl 8
@@ -222,7 +222,7 @@
}
unix {
return "#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX
*/\n${text}#endif /* UNIX */\n"
- }
+ }
mac {
return "#ifdef MAC_TCL\n${text}#endif /* MAC_TCL */\n"
}
@@ -396,7 +396,7 @@
}
}
append text $line
-
+
append text ");"
format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \
$fname $fname $text
@@ -466,7 +466,7 @@
set arg1 [lindex $args 0]
if {![string compare $arg1 "TCL_VARARGS"]} {
- lassign [lindex $args 1] type argName
+ lassign [lindex $args 1] type argName
append text " TCL_VARARGS_DEF($type,$argName)\n\{\n"
append text " " $type " var;\n va_list argList;\n"
if {[string compare $rtype "void"]} {
@@ -548,7 +548,7 @@
append text ")"
}
}
-
+
append text "); /* $index */\n"
return $text
}
@@ -626,9 +626,9 @@
}
}
#
- # "aqua" and "macosx" and "x11" are special cases,
- # since "macosx" always implies "unix" and "aqua",
- # "macosx", so we need to be careful not to
+ # "aqua" and "macosx" and "x11" are special cases,
+ # since "macosx" always implies "unix" and "aqua",
+ # "macosx", so we need to be careful not to
# emit duplicate stubs entries for the two.
#
if {[info exists stubs($name,aqua,$i)]
@@ -655,7 +655,7 @@
eval {append text} $skipString
}
}
-
+
} else {
# Emit separate stubs blocks per platform
foreach plat {unix win mac} {
@@ -760,7 +760,7 @@
set upName [string toupper $libraryName]
append text "\n#if defined(USE_${upName}_STUBS) &&
!defined(USE_${upName}_STUB_PROCS)\n"
append text "\n/*\n * Inline function declarations:\n */\n\n"
-
+
forAllStubs $name makeMacro 0 text
append text "\n#endif /* defined(USE_${upName}_STUBS) &&
!defined(USE_${upName}_STUB_PROCS) */\n"
@@ -829,7 +829,7 @@
forAllStubs $name makeStub 0 text
rewriteFile [file join $outDir ${name}Stubs.c] $text
- return
+ return
}
# genStubs::emitInit --
@@ -867,7 +867,7 @@
} else {
append text " NULL,\n"
}
-
+
forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"}
append text "\};\n"
This was sent by the SourceForge.net collaborative development platform, the
world's largest Open Source development site.
------------------------------------------------------------------------------
Protect Your Site and Customers from Malware Attacks
Learn about various malware tactics and how to avoid them. Understand
malware threats, the impact they can have on your business, and how you
can protect your company and customers by using code signing.
http://p.sf.net/sfu/oracle-sfdevnl
_______________________________________________
BRL-CAD Source Commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/brlcad-commits
