diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2025-08-22 19:22:05 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2025-08-22 19:22:05 (GMT) |
| commit | 10b1362daa6a99d02ce1f417bb2643f1fc6fa89d (patch) | |
| tree | 67631c533882205198e33216e9169dabd24e0c04 /tools/tclOOScript.tcl | |
| parent | 0a21b6eed51f2f8acc6fcfd64559626b6c97b6d9 (diff) | |
| download | tcl-10b1362daa6a99d02ce1f417bb2643f1fc6fa89d.zip tcl-10b1362daa6a99d02ce1f417bb2643f1fc6fa89d.tar.gz tcl-10b1362daa6a99d02ce1f417bb2643f1fc6fa89d.tar.bz2 | |
Move [link] into C. (backport)
Diffstat (limited to 'tools/tclOOScript.tcl')
| -rw-r--r-- | tools/tclOOScript.tcl | 51 |
1 files changed, 0 insertions, 51 deletions
diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl index 4509202..1564645 100644 --- a/tools/tclOOScript.tcl +++ b/tools/tclOOScript.tcl @@ -12,57 +12,6 @@ # this file, and for a DISCLAIMER OF ALL WARRANTIES. ::namespace eval ::oo { - - # - # Commands that are made available to objects by default. - # - - # ------------------------------------------------------------------ - # - # link -- - # - # Make a command that invokes a method on the current object. - # The name of the command and the name of the method match by - # default. - # - # ------------------------------------------------------------------ - - proc Helpers::link {args} { - set ns [uplevel 1 {::namespace current}] - foreach link $args { - if {[llength $link] == 2} { - lassign $link src dst - } elseif {[llength $link] == 1} { - lassign $link src - set dst $src - } else { - return -code error -errorcode {TCL OO CMDLINK_FORMAT} \ - "bad link description; must only have one or two elements" - } - if {![string match ::* $src]} { - set src [string cat $ns :: $src] - } - interp alias {} $src {} ${ns}::my $dst - trace add command ${ns}::my delete [list \ - ::oo::UnlinkLinkedCommand $src] - } - } - - # ---------------------------------------------------------------------- - # - # UnlinkLinkedCommand -- - # - # Callback used to remove linked command when the underlying mechanism - # that supports it is deleted. - # - # ---------------------------------------------------------------------- - - proc UnlinkLinkedCommand {cmd args} { - if {[namespace which $cmd] ne {}} { - rename $cmd {} - } - } - # ---------------------------------------------------------------------- # # UpdateClassDelegatesAfterClone -- |