/usr/share/tcltk/nsf-nx/plain-object-method.tcl is in nsf 2.0.0-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | package provide nx::plain-object-method 1.0
#
# Provide a convenience layer to define/introspect object specific
# methods without having to use the "object" modifier. By using this
# package, one can use instead of
#
# nx::Object create o {
# :public object method foo args {....}
# :object property p:integer
# :object mixins add M
# #...
# puts [:info object methods]
# }
#
# simply
#
# package require nx::plain-object-method
#
# nx::Object create o {
# :public method foo args {....}
# :property p:integer
# :mixins add M
# #...
# puts [:info methods]
# }
#
# Note that for object specific methods of classes, one has still to
# use "object method" etc. (see also package nx::plass-method).
#
namespace eval ::nx {
#
# Define a method to allow configuration for tracing of the
# convenience methods. Use
#
# nx::configure plain-object-method-warning on|off
#
# for activation/deactivation of tracing. This might be
# useful for porting legacy NX programs or for testing
# default-configuration compliance.
#
nx::configure public object method plain-object-method-warning {onoff:boolean,optional} {
if {[info exists onoff]} {
set :plain-object-method-warning $onoff
} else {
if {[info exists :plain-object-method-warning]} {
if {${:plain-object-method-warning}} {
uplevel {::nsf::log warn "plain object method: [self] [current method] [current args]"}
}
}
}
}
nx::Object eval {
#
# Definitions redirected to "object"
#
foreach m {
alias
filters
forward
method
mixins
property
variable
} {
:public method $m {args} {
nx::configure plain-object-method-warning
:object [current method] {*}[current args]
}
}
#
# info subcommands
#
foreach m {
method methods slots variables
filters mixins
} {
:public method "info $m" {args} [subst -nocommands {
nx::configure plain-object-method-warning
:info object $m {*}[current args]
}]
}
#
# deletions for object
#
foreach m {
"property"
"variable"
"method"
} {
nx::Object public method "delete $m" {args} {
nx::configure plain-object-method-warning
:delete object [current method] {*}[current args]
}
}
}
Object eval {
#
# method require, base cases
#
:method "require method" {methodName} {
nx::configure plain-object-method-warning
::nsf::method::require [::nsf::self] $methodName 1
return [:info lookup method $methodName]
}
#
# method require, public explicitly
#
:method "require public method" {methodName} {
nx::configure plain-object-method-warning
set result [:require object method $methodName]
::nsf::method::property [self] $result call-protected false
return $result
}
#
# method require, protected explicitly
#
:method "require protected method" {methodName} {
nx::configure plain-object-method-warning
set result [:require object method $methodName]
::nsf::method::property [self] $result call-protected true
return $result
}
#
# method require, private explicitly
#
:method "require private method" {methodName} {
set result [:require object method $methodName]
::nsf::method::property [self] $result call-private true
return $result
}
}
}
|