Class ::xotcl::Object (public)

 ::xotcl::Class ::xotcl::Object

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xotcl {}
::nsf::object::alloc ::xotcl::Class ::xotcl::Object {}
::xotcl::Object proc getExitHandler {} {::nsf::exithandler get}
::xotcl::Object proc setExitHandler newbody {::nsf::exithandler set $newbody}
::xotcl::Object proc unsetExitHandler {} {::nsf::exithandler unset}
::xotcl::Object instproc method {-debug:switch -deprecated:switch name arguments:parameter,0..* -returns body} {
     set returns_flag [expr {[info exists returns] ? [list -returns $returns] : {}}]
     :proc -debug=$debug -deprecated=$deprecated $name $arguments {*}$returns_flag $body
   }
::xotcl::Object instproc isclass {{class:substdefault  "[self]"}} {::nsf::is class $class}
::xotcl::Object instproc check checkoptions {
    ::nsf::method::assertion [self] check [::xotcl::checkoption_xotcl1_to_internal $checkoptions]
  }
::xotcl::Object instproc debug args {
  set msg [join $args { }]
  ns_log debug "[self] [self callingclass]->[self callingproc]: $msg"
}
::xotcl::Object instproc serialize -target {
      set objmap [expr {[info exists target] ? [list [::nsf::current object] $target] : ""}]
      ::Serializer deepSerialize -objmap $objmap [::nsf::current object]
    }
::xotcl::Object instproc unknown {m args} {
    if {![self isnext]} {
      error "[self]: unable to dispatch method '$m'"
    }
  }
::xotcl::Object instproc mset pairs {
  #
  # Import all attribute value pairs into the current XOTcl object.
  #
  if {[llength $pairs] > 0} {
    nsf::directdispatch [self] -frame object ::lassign [dict values $pairs] {*}[dict keys $pairs]
  }
}
::xotcl::Object instproc set_instance_vars_defaults {} :configure
::xotcl::Object instproc isobject {{object:substdefault "[self]"}} {::nsf::object::exists $object}
::xotcl::Object instproc proc {-debug:switch -deprecated:switch name arguments -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] -per-object $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::Object instproc www-show-object {} {
  #
  # Allow to show an arbitrary object via API-browser.  Per-default,
  # e.g. a site-wide admin can use e.g. /xowiki/index?m=show-object
  #
  if {[ns_conn isconnected]} {
    set form [ns_getform]
    ns_set update $form object [self]
    ns_set update $form show_source    [::xo::cc query_parameter show_source:integer 1]
    ns_set update $form show_methods   [::xo::cc query_parameter show_methods:integer 2]
    ns_set update $form show_variables [::xo::cc query_parameter show_variables:integer 1]
    ns_set update $form as_img 1
    rp_internal_redirect /packages/xotcl-core/www/show-object
  } else {
    ns_log error "show-object can only be called with an active connection"
  }
  ad_script_abort
}
::xotcl::Object instproc __timediff {} {
  set now [ns_time get]
  if {[ns_conn isconnected]} {
    set start_time [ns_conn start]
  } else {
    if {![info exists ::__start_time]} {set ::__start_timestamp $now}
    set start_time $::__start_timestamp
  }
  set t [ns_time diff $now $start_time]
  set ms [expr {[ns_time seconds $t]*1000 + [ns_time microseconds $t]/1000}]
  if {[info exists ::__last_timestamp]} {
    set t [ns_time diff $now $::__last_timestamp]
    set dms [expr {[ns_time seconds $t]*1000 + [ns_time microseconds $t]/1000}]
    set diff ", ${dms}ms"
  } else {
    set diff ""
  }
  set ::__last_timestamp $now
  return "${ms}ms$diff"
}
::xotcl::Object instproc istype class {
    return [expr {[::nsf::is class $class] &&
          [::nsf::directdispatch [self] ::nsf::methods::object::info::hastype $class]}]
  }
::xotcl::Object instproc __object_configureparameter {} {
    set slotObjects [nsf::directdispatch [self] ::nsf::methods::object::info::lookupslots -type ::nx::Slot]
    set parameterDefinitions [::nsf::parameter::specs $slotObjects]
    lappend parameterDefinitions args:alias,method=residualargs,args
  }
::xotcl::Object instproc filtersearch filter {
    set handle [::nsf::directdispatch [::nsf::current object]  ::nsf::methods::object::info::lookupfilter $filter]
    return [method_handle_to_xotcl $handle]
  }
::xotcl::Object instproc ad_proc {{-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] proc {*}$flags $proc_name $arguments {*}$returnSpec $body]
  ::xo::api update_method_doc  -protection [expr {$private ? "private" : "public"}]  -deprecated=$deprecated  -debug=$debug  [::xo::api scope] [self]  "" $proc_name $doc
}
::xotcl::Object instproc ad_doc doc_string {
  ::xo::api update_object_doc [::xo::api scope] [self] $doc_string
}
::xotcl::Object instproc hasclass cl {
    if {![::nsf::is class $cl]} {return 0}
    if {[::nsf::directdispatch [self] ::nsf::methods::object::info::hasmixin $cl]} {return 1}
    ::nsf::directdispatch [self] ::nsf::methods::object::info::hastype $cl
  }
::xotcl::Object instproc self {} ::xotcl::self
::xotcl::Object instproc qn query_name {
  #set qn "dbqd.[:uplevel [list self class]]-[:uplevel [list self proc]].$query_name"
  set l [info level]
  if {$l < 2} {
    set prefix topLevel
  } else {
    set prefix [lindex [:uplevel {info level 0}] 0]
    #ns_log notice "QN <$query_name> -> PREFIX <$prefix>"
  }
  return "dbqd.$prefix.$query_name"
}
::xotcl::Object instproc ad_forward {{-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] forward {*}$flags $method_name $args
    ::xo::api update_method_doc  -protection [expr {$private ? "private" : "public"}]  -deprecated=$deprecated  -debug=$debug  [::xo::api scope] [self]  "" $method_name $doc
  }
::xotcl::Object instproc ismetaclass {{class:substdefault  "[self]"}} {::nsf::is metaclass $class}
::xotcl::Object instproc ismixin class {
    return [expr {[::nsf::is class $class] &&
          [my ::nsf::methods::object::info::hasmixin $class]}]
  }
::xotcl::Object instproc procsearch name {
    set handle [::nsf::directdispatch [::nsf::current object]  ::nsf::methods::object::info::lookupmethod $name]
    return [method_handle_to_xotcl $handle]
  }
::xotcl::Object instproc vwait varName {
    if {[regexp {:[^:]*} $varName]} {
      error "invalid varName '$varName'; only plain or fully qualified variable names allowed"
    }
    if {[string match ::* $varName]} {
      ::vwait $varName
    } else {
      ::vwait :$varName
    }
  }
::xotcl::Object instproc msg {{-html false} args} {
  set msg [join $args { }]
  if {[ns_conn isconnected]} {
    set msg "[self]: $msg  ([self callingclass]->[self callingproc])"
    if {$html} {
      util_user_message -html -message $msg
    } else {
      util_user_message -message $msg
    }
  }
}
::xotcl::Object instproc extractConfigureArg {al name {cutTheArg 0}} {
    set value ""
    ::upvar $al argList
    set largs [llength $argList]
    for {set i 0} {$i < $largs} {incr i} {
      if {[lindex $argList $i] == $name && $i + 1 < $largs} {
        set startIndex $i
        set endIndex [expr {$i + 1}]
        while {$endIndex < $largs &&
               [string first - [lindex $argList $endIndex]] != 0} {
          lappend value [lindex $argList $endIndex]
          incr endIndex
        }
      }
    }
    if {[info exists startIndex] && $cutTheArg != 0} {
      set argList [lreplace $argList $startIndex [expr {$endIndex - 1}]]
    }
    return $value
  }
::xotcl::Object instproc init args {
    if {![::nsf::current isnextcall] && [llength $args] > 0 && [::nsf::configure debug] > 0} {
      ::nsf::log Warning "Arguments '$args' to constructor of object [self] are most likely not processed"
    }
  }
::xotcl::Object instproc forward {-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] -per-object $method {*}$arglist]
    if {$debug} {::nsf::method::property [self] $r debug true}
    if {$deprecated} {::nsf::method::property [self] $r deprecated true}
    return $r
  }
::xotcl::Object instproc ds args {
  set msg [join $args { }]
  ds_comment "[self] [self callingclass]->[self callingproc]: $msg ([:__timediff])"
}
::xotcl::Object instproc asHTML {{-master defaultMaster} -page:switch} {
  ::xo::require_html_procs
  dom createDocument html doc
  set root [$doc documentElement]
  if {!$page} {
    $root appendFromScript {:render}
    set nodes [$root childNode]
    return [join [lmap n $nodes {$n asHTML}] \n]
  } else {
    set slave [$master decorate $root]
    $slave appendFromScript {:render}
    ns_return 200 text/html [$root asHTML]
  }
}
::xotcl::Object instproc log args {
  set msg [join $args { }]
  ns_log notice "[self] [self callingclass]->[self callingproc]: $msg ([:__timediff])"
}
::xotcl::Object instproc abstract {methtype methname arglist} {
    if {$methtype ne "proc" && $methtype ne "instproc" && $methtype ne "method"} {
      error "invalid method type '$methtype',  must be either 'proc', 'instproc' or 'method'."
    }
    set arglist2 $arglist
    regsub -all {\"} $arglist {\\"} arglist2
    :$methtype $methname $arglist "
      if {!\[::xotcl::self isnextcall\]} {
        error \"Abstract method $methname $arglist2 called\"
      } else {::xotcl::next}
    "
    # balance " for emacs syntax highlighter
  }
::xotcl::Object instproc destroy_on_cleanup {} {
    #:log "--cleanup adding ::xo::cleanup([self]) [list [self] destroy]"
    set ::xo::cleanup([self]) [list [self] destroy]
  }
::xotcl::Object instforward db_1row -objscope ::db_1row
::xotcl::Object instforward filter -methodprefix value= ::xotcl::Object::slot::filter {%1 {get set}} %self object-filter
::xotcl::Object instforward parametercmd ::nsf::method::setter %self -per-object
::xotcl::Object instforward mixin -methodprefix value= ::xotcl::Object::slot::mixin {%1 {get set}} %self object-mixin
::xotcl::Object instforward db_0or1row -objscope ::db_0or1row
::xotcl::Object instforward invar ::nsf::method::assertion %self object-invar
::xotcl::Object instforward class -methodprefix value= ::xotcl::Object::slot::class {%1 {get set}} %self class
::nsf::method::alias ::xotcl::Object subst -frame object ::subst
::nsf::method::alias ::xotcl::Object configure ::nsf::methods::object::configure
::nsf::method::alias ::xotcl::Object residualargs ::nsf::methods::object::residualargs
::nsf::method::alias ::xotcl::Object eval -frame object ::eval
::nsf::method::alias ::xotcl::Object autoname ::nsf::methods::object::autoname
::nsf::method::alias ::xotcl::Object requireNamespace ::nsf::methods::object::requirenamespace
::nsf::method::alias ::xotcl::Object lappend -frame object ::lappend
::nsf::method::alias ::xotcl::Object move ::nsf::classes::nx::Object::move
::nsf::method::alias ::xotcl::Object instvar ::nsf::methods::object::instvar
::nsf::method::alias ::xotcl::Object exists ::nsf::methods::object::exists
::nsf::method::alias ::xotcl::Object volatile ::nsf::methods::object::volatile1
::nsf::method::alias ::xotcl::Object info ::xotcl::objectInfo
::nsf::method::alias ::xotcl::Object array -frame object ::array
::nsf::method::alias ::xotcl::Object cleanup ::nsf::methods::object::cleanup
::nsf::method::alias ::xotcl::Object filterguard ::nsf::methods::object::filterguard
::nsf::method::alias ::xotcl::Object contains ::nsf::classes::nx::Object::contains
::nsf::method::alias ::xotcl::Object append -frame object ::append
::nsf::method::alias ::xotcl::Object noinit ::nsf::methods::object::noinit
::nsf::method::alias ::xotcl::Object set -frame object ::set
::nsf::method::alias ::xotcl::Object defaultmethod ::nsf::methods::object::defaultmethod
::nsf::method::alias ::xotcl::Object trace -frame object ::trace
::nsf::method::alias ::xotcl::Object destroy ::nsf::methods::object::destroy
::nsf::method::alias ::xotcl::Object dict -frame object ::dict
::nsf::method::alias ::xotcl::Object uplevel ::nsf::methods::object::uplevel
::nsf::method::alias ::xotcl::Object copy ::nsf::classes::nx::Object::copy
::nsf::method::alias ::xotcl::Object upvar ::nsf::methods::object::upvar
::nsf::method::alias ::xotcl::Object unset -frame object ::unset
::nsf::method::alias ::xotcl::Object mixinguard ::nsf::methods::object::mixinguard
::nsf::method::alias ::xotcl::Object incr -frame object ::incr

::nx::slotObj -container slot ::xotcl::Object

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

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

::nsf::object::alloc ::xotcl::RelationSlot ::xotcl::Object::slot::filter {set :accessor public
   set :configurable true
   set :defaultmethods {get set}
   set :disposition alias
   set :domain ::xotcl::Object
   set :elementtype filterreg
   set :forwardername object-filter
   set :incremental false
   set :manager ::xotcl::Object::slot::filter
   set :methodname filter
   set :multiplicity 0..n
   set :name filter
   set :parameterSpec -filter:filterreg,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