Class ::xotcl::Class (public)

 ::xotcl::Class ::xotcl::Class

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xotcl {}
::nsf::object::alloc ::xotcl::Class ::xotcl::Class {}
::xotcl::Class proc __unknown name {}
::xotcl::Class instproc uses list {
    foreach package $list {
      ::xotcl::package import -into [::xotcl::self] $package
      puts stderr "*** using ${package}::* in [::xotcl::self]"
    }
  }
::xotcl::Class instproc extend_slot arg {

  # The argument list is e.g. "foo -name x -title y"
  #
  # It is placed into one argument to avoid interference with the "-"
  # argument parsing since it will always start with a non-dashed
  # value.
  #
  set name [lindex $arg 0]
  set config [lrange $arg 1 end]

  # search for slot
  foreach c [:info heritage] {
    if {[nsf::is object ${c}::slot::$name]} {
      set slot ${c}::slot::$name
      break
    }
  }
  if {![info exists slot]} {error "can't find slot $name"}

  # copy slot and configure it
  set newSlot [self]::slot::$name

  $slot copy $newSlot
  $newSlot configure  -domain [self]  -manager $newSlot  -create_acs_attribute false  -create_table_attribute false  {*}$config
  #
  # Changing the domain is necessary for "update_attribute_from_slot"
  # for the extended slots like "title", "description" etc. But then
  # the accessor methods (for "title", "description") have to be
  # installed manually for the classes, on which the extension
  # happens.
  #
  ::nsf::method::setter [$newSlot domain] $name
  ns_log notice "=== change domain of $name from [$newSlot domain] to [$slot domain]"
  $newSlot domain [$slot domain]

  #
  set :db_slot($name) $newSlot
}
::xotcl::Class instproc allinstances {} {
    # TODO: mark it deprecated
    return [:info instances -closure]
  }
::xotcl::Class instproc parameter arglist {
    set slotContainer [::nx::slotObj [::nsf::self]]
    foreach arg $arglist {
      #puts stderr "PARAMETER: [self] ::nsf::classes::nx::Class::property -accessor public $arg"
      [self] ::nsf::classes::nx::Class::property -class ::xotcl::Attribute -accessor public $arg
      ::nsf::method:::setter [self] [lindex $arg 0]
    }
    ::nsf::var::set $slotContainer __parameter $arglist
  }
::xotcl::Class instproc method {-debug:switch -deprecated:switch -per-object:switch name arguments:parameter,0..* body} {
     set returns_flag [expr {[info exists returns] ? [list -returns $returns] : {}}]
     if {${per-object}} {
       :proc -debug=$debug -deprecated=$deprecated $name $arguments {*}$returns_flag $body
     } else {
       :instproc -debug=$debug -deprecated=$deprecated $name $arguments {*}$returns_flag $body
     }
   }
::xotcl::Class instproc instforward {-debug:switch -deprecated:switch method -default -earlybinding:switch -methodprefix -objscope:switch -onerror -verbose:switch target:optional args} {
    set arglist [list]
    if {[info exists target] && [string index $target 0] eq "-"} {
      error "target '$target' must not start with a dash"
    }
    if {[info exists default]} {lappend arglist -default $default}
    if {$earlybinding} {lappend arglist -earlybinding}
    if {[info exists methodprefix]} {lappend arglist -prefix $methodprefix}
    if {$objscope} {lappend arglist -frame object}
    if {[info exists onerror]} {lappend arglist -onerror $onerror}
    if {$verbose} {lappend arglist -verbose}
    if {[info exists target]} {lappend arglist $target}
    if {[llength $args] > 0} {lappend arglist {*}$args}
    set r [::nsf::method::forward [self] $method {*}$arglist]
    if {$debug} {::nsf::method::property [self] $r debug true}
    if {$deprecated} {::nsf::method::property [self] $r deprecated true}
    return $r
  }
::xotcl::Class instproc slots cmd {
    set slotContainer [::nx::slotObj [self]]
    ::uplevel [list [self] contains -object $slotContainer $cmd]
  }
::xotcl::Class instproc __class_configureparameter {} {
    set slotObjects [nsf::directdispatch [self] ::nsf::methods::class::info::slotobjects -closure -type ::nx::Slot]
    set parameterDefinitions [::nsf::parameter::specs $slotObjects]
    lappend parameterDefinitions args:alias,method=residualargs,args
  }
::xotcl::Class instproc ad_instforward {{-private:switch false} {-deprecated:switch false} {-warn:switch false} {-debug:switch false} method_name doc args} {
    set flags [::xo::api get_proc_definition_flags $debug $deprecated]
    uplevel [self] instforward {*}$flags $method_name $args
    ::xo::api update_method_doc  -protection [expr {$private ? "private" : "public"}]  -deprecated=$deprecated  -debug=$debug  [::xo::api scope] [self]  "inst" $method_name $doc
  }
::xotcl::Class instproc unknown args {
    # puts stderr "use '[self] create $args', not '[self] $args'"
    set lvl 1
    if {[::nsf::current isnextcall]} {
      set lvl [::nsf::current callinglevel]
    }
    ::uplevel $lvl [list [self] create {*}$args]
  }
::xotcl::Class instproc instproc {-debug:switch -deprecated:switch name arguments:parameter,0..* -returns body precondition:optional postcondition:optional} {
    set conditions [list]
    if {[info exists precondition]}  {lappend conditions -precondition  $precondition}
    if {[info exists postcondition]} {lappend conditions -postcondition $postcondition}
    set r [::nsf::method::create [self] $name $arguments $body {*}$conditions]
    if {$debug} {::nsf::method::property [self] $r debug true}
    if {$deprecated} {::nsf::method::property [self] $r deprecated true}
    if {[info exists returns]} {::nsf::method::property [self] $r returns $returns}
    return $r
  }
::xotcl::Class instproc extend_slot_default {name value} {
    # Search for the slot. If the slot exists, extend its default
    # value with the new value
    foreach c [:info heritage] {
      if {[nsf::is object ${c}::slot::$name]} {
        set value [list $value {*}[${c}::slot::$name default]]
        break
      }
    }
    # create a mirroring slot with the maybe extended default
    :slots [list Attribute create $name -default $value]
  }
::xotcl::Class instproc ad_instproc {{-private:switch false} {-deprecated:switch false} {-warn:switch false} {-debug:switch false} proc_name arguments:parameter,0..* {-returns ""} doc body} {
  set flags [::xo::api get_proc_definition_flags $debug $deprecated]
  set returnSpec [::xo::api get_returns_spec $returns]
  uplevel [list [self] instproc {*}$flags $proc_name $arguments {*}$returnSpec $body]
  ::xo::api update_method_doc  -protection [expr {$private ? "private" : "public"}]  -deprecated=$deprecated  -debug=$debug  [::xo::api scope] [self]  inst $proc_name $doc
}
::xotcl::Class instforward instmixin -methodprefix value= ::xotcl::Class::slot::instmixin {%1 {get set}} %self class-mixin
::xotcl::Class instforward instparametercmd ::nsf::method::setter %self
::xotcl::Class instforward superclass -methodprefix value= ::xotcl::Class::slot::superclass {%1 {get set}} %self superclass
::xotcl::Class instforward instinvar ::nsf::method::assertion %self class-invar
::xotcl::Class instforward instfilter -methodprefix value= ::xotcl::Class::slot::instfilter {%1 {get set}} %self class-filter
::xotcl::Class instparametercmd __default_metaclass
::xotcl::Class instparametercmd __default_superclass
::nsf::method::alias ::xotcl::Class new ::nsf::methods::class::new
::nsf::method::alias ::xotcl::Class alloc ::nsf::methods::class::alloc
::nsf::method::alias ::xotcl::Class info ::xotcl::classInfo
::nsf::method::alias ::xotcl::Class create ::nsf::methods::class::create
::nsf::method::alias ::xotcl::Class dealloc ::nsf::methods::class::dealloc
::nsf::method::alias ::xotcl::Class instmixinguard ::nsf::methods::class::mixinguard
::nsf::method::alias ::xotcl::Class instfilterguard ::nsf::methods::class::filterguard
::nsf::method::alias ::xotcl::Class recreate ::nsf::methods::class::recreate

::nsf::object::alloc ::nx::BootStrapVariableSlot ::xotcl::Class::slot::__default_superclass {set :accessor public
   set :configurable 1
   set :default ::xotcl::Object
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::Class
   set :incremental false
   set :manager ::xotcl::Class::slot::__default_superclass
   set :multiplicity 1..1
   set :name __default_superclass
   set :parameterSpec {-__default_superclass ::xotcl::Object}
   set :per-object false
   set :position 0
   set :required false
   : init}

::nsf::object::alloc ::nx::BootStrapVariableSlot ::xotcl::Class::slot::__default_metaclass {set :accessor public
   set :configurable 1
   set :default ::xotcl::Class
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xotcl::Class
   set :incremental false
   set :manager ::xotcl::Class::slot::__default_metaclass
   set :multiplicity 1..1
   set :name __default_metaclass
   set :parameterSpec {-__default_metaclass ::xotcl::Class}
   set :per-object false
   set :position 0
   set :required false
   : init}

::nsf::object::alloc ::xotcl::RelationSlot ::xotcl::Class::slot::instmixin {set :accessor public
   set :configurable true
   set :defaultmethods {get set}
   set :disposition alias
   set :domain ::xotcl::Class
   set :elementtype mixinreg
   set :forwardername class-mixin
   set :incremental false
   set :manager ::xotcl::Class::slot::instmixin
   set :methodname instmixin
   set :multiplicity 0..n
   set :name instmixin
   set :parameterSpec -instmixin:mixinreg,alias,0..n
   set :per-object false
   set :position 0
   set :required false
   : init}

::nsf::object::alloc ::xotcl::RelationSlot ::xotcl::Class::slot::instfilter {set :accessor public
   set :configurable true
   set :defaultmethods {get set}
   set :disposition alias
   set :domain ::xotcl::Class
   set :elementtype filterreg
   set :forwardername class-filter
   set :incremental false
   set :manager ::xotcl::Class::slot::instfilter
   set :methodname instfilter
   set :multiplicity 0..n
   set :name instfilter
   set :parameterSpec -instfilter:filterreg,alias,0..n
   set :per-object false
   set :position 0
   set :required false
   : init}

::nx::slotObj -container slot ::xotcl::Class

::nsf::object::alloc ::xotcl::RelationSlot ::xotcl::Class::slot::superclass {set :accessor public
   set :configurable true
   set :defaultmethods {get set}
   set :disposition alias
   set :domain ::xotcl::Class
   set :forwardername superclass
   set :incremental false
   set :manager ::xotcl::Class::slot::superclass
   set :methodname superclass
   set :multiplicity 0..n
   set :name superclass
   set :parameterSpec -superclass:alias,0..n
   set :per-object false
   set :position 0
   set :required false
   : init}

namespace eval ::xotcl {::namespace export Object Class Attribute myproc myvar my self next @}

XQL Not present:

Generic, PostgreSQL, Oracle