OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /or1k/trunk/insight/itcl/itcl/library
    from Rev 578 to Rev 1765
    ↔ Reverse comparison
  •

Rev 578 → Rev 1765

/itcl.tcl
0,0 → 1,149
#
# itcl.tcl
# ----------------------------------------------------------------------
# Invoked automatically upon startup to customize the interpreter
# for [incr Tcl].
# ----------------------------------------------------------------------
# AUTHOR: Michael J. McLennan
# Bell Labs Innovations for Lucent Technologies
# mmclennan@lucent.com
# http://www.tcltk.com/itcl
#
# RCS: $Id: itcl.tcl,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
# ----------------------------------------------------------------------
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
# ======================================================================
# See the file "license.terms" for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
# ----------------------------------------------------------------------
# USAGE: local <className> <objName> ?<arg> <arg>...?
#
# Creates a new object called <objName> in class <className>, passing
# the remaining <arg>'s to the constructor. Unlike the usual
# [incr Tcl] objects, however, an object created by this procedure
# will be automatically deleted when the local call frame is destroyed.
# This command is useful for creating objects that should only remain
# alive until a procedure exits.
# ----------------------------------------------------------------------
proc ::itcl::local {class name args} {
set ptr [uplevel eval [list $class $name] $args]
uplevel [list set itcl-local-$ptr $ptr]
set cmd [uplevel namespace which -command $ptr]
uplevel [list trace variable itcl-local-$ptr u \
"itcl::delete object $cmd; list"]
return $ptr
}
 
# ----------------------------------------------------------------------
# auto_mkindex
# ----------------------------------------------------------------------
# Define Itcl commands that will be recognized by the auto_mkindex
# parser in Tcl...
#
 
#
# USAGE: itcl::class name body
# Adds an entry for the given class declaration.
#
foreach cmd {itcl::class itcl_class} {
auto_mkindex_parser::command $cmd {name body} {
variable index
variable scriptFile
append index "set [list auto_index([fullname $name])]"
append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
 
variable parser
variable contextStack
set contextStack [linsert $contextStack 0 $name]
$parser eval $body
set contextStack [lrange $contextStack 1 end]
}
}
 
#
# USAGE: itcl::body name arglist body
# Adds an entry for the given method/proc body.
#
auto_mkindex_parser::command itcl::body {name arglist body} {
variable index
variable scriptFile
append index "set [list auto_index([fullname $name])]"
append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
 
#
# USAGE: itcl::configbody name arglist body
# Adds an entry for the given method/proc body.
#
auto_mkindex_parser::command itcl::configbody {name body} {
variable index
variable scriptFile
append index "set [list auto_index([fullname $name])]"
append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
 
#
# USAGE: ensemble name ?body?
# Adds an entry to the auto index list for the given ensemble name.
#
auto_mkindex_parser::command itcl::ensemble {name {body ""}} {
variable index
variable scriptFile
append index "set [list auto_index([fullname $name])]"
append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
 
#
# USAGE: public arg ?arg arg...?
# protected arg ?arg arg...?
# private arg ?arg arg...?
#
# Evaluates the arguments as commands, so we can recognize proc
# declarations within classes.
#
foreach cmd {public protected private} {
auto_mkindex_parser::command $cmd {args} {
variable parser
$parser eval $args
}
}
 
# CYGNUS LOCAL
# This version of auto_import does not work, because it relies
# WHOLLY on the tclIndex files, but the tclIndex files have no
# notion of what the export list for a namespace is. So at the
# time you do "namespace import" the export list is empty, and
# so nothing is imported.
# Until that is fixed, it is best just to go back to the original
# Tcl version of auto_import...
 
# ----------------------------------------------------------------------
# auto_import
# ----------------------------------------------------------------------
# This procedure overrides the usual "auto_import" function in the
# Tcl library. It is invoked during "namespace import" to make see
# if the imported commands reside in an autoloaded library. If so,
# stubs are created to represent the commands. Executing a stub
# later on causes the real implementation to be autoloaded.
#
# Arguments -
# pattern The pattern of commands being imported (like "foo::*")
# a canonical namespace as returned by [namespace current]
 
#proc auto_import {pattern} {
# global auto_index
 
# set ns [uplevel namespace current]
# set patternList [auto_qualify $pattern $ns]
 
# auto_load_index
 
# foreach pattern $patternList {
# foreach name [array names auto_index $pattern] {
# if {"" == [info commands $name]} {
# ::itcl::import::stub create $name
# }
# }
# }
# }
itcl.tcl Property changes : Added: svn:executable ## -0,0 +1 ## +* \ No newline at end of property

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.