/usr/lib/tcltk/owtcl-1.0/ow.tcl is in libow-tcl 2.8p15-1ubuntu4.
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 145 146 147 148 149 150 151 152 | # -*- Tcl -*-
# File: ow.tcl
#
# Created: Tue Jan 11 20:34:11 2005
#
# $Id: ow.tcl,v 1.3 2011/07/08 08:42:42 oskin Exp $
#
namespace eval ::OW {
proc ::OW { args } { return [eval ::OW::init $args] }
proc ::ow { args } { return [eval ::OW::ow $args] }
}
proc ::OW::init {args} {
array set oldopts {
-format -f
-celsius -C
-fahenheit -F
-kelvin -K
-rankine -R
-readonly -r
-cache -t
}
set sargs ""
foreach arg $args {
if {[info exists oldopts($arg)]} {
append sargs $oldopts($arg) { }
} else {
append sargs $arg { }
}
}
set sargs [string trim $sargs]
return [::OW::_init $sargs]
}
proc ::OW::ow {opt args} {
switch -exact $opt {
open {
return [eval ::OW::init $args]
}
close {
return [eval ::OW::finish $args]
}
version {
return [eval ::OW::version $args]
}
error {
return [eval ::OW::set_error $args]
}
opened {
return [eval ::OW::isconnect $args]
}
get {
return [eval ::OW::get $args]
}
put {
return [eval ::OW::put $args]
}
isdir {
return [eval ::OW::isdir $args]
}
isdirectory {
return [eval ::OW::isdir $args]
}
set {
return [eval ::OW::_set $args]
}
default {
error "bad option \"$opt\": must be open, close, version, error, opened, get, put, set, isdir or isdirectory"
}
}
}
proc ::OW::_join {args} {
foreach a $args {
append res {/} [string trim $a {/}]
}
regsub -all {//} $res {/} res
return $res
}
proc ::OW::_set {path} {
set path "/[string trim $path {/}]"
if {[exists $path]} {
set id_set 0
while {[info commands [set nid "::OW::owcmd$id_set"]] != ""} {
incr id_set
}
set evalstr [format {proc %s {args} {return [eval ::OW::device %s $args]}} $nid $path]
eval $evalstr
return $nid
} else {
error "node \"$path\" not exists"
}
}
proc ::OW::device {base opt args} {
set path $base
switch -exact $opt {
get {
set lst {}
if {[set x [lsearch -exact $args {-list}]] >= 0} {
set lst {-list}
set args [lreplace $args $x $x]
}
set path [_join $base [lindex $args 0]]
return [eval ::OW::get $path $lst]
}
put {
if {[llength $args] > 1} {
set path [_join $base [lindex $args 0]]
set args [lreplace $args 0 0]
}
return [eval ::OW::put $path $args]
}
isdir {
return [eval ::OW::isdir [_join $base [lindex $args 0]]]
}
isdirectory {
return [eval ::OW::isdir [_join $base [lindex $args 0]]]
}
set {
return [eval ::OW::_set [_join $base [lindex $args 0]]]
}
path {
return $path
}
default {
error "bad option \"$opt\": must be get, put, set, path, isdir or isdirectory"
}
}
}
proc ::OW::set_error {opt args} {
switch -exact $opt {
level {
if {$args == ""} {
error "wrong # args: should be \"ow error level ?val?\""
}
eval ::OW::set_error_level $args
}
print {
if {$args == ""} {
error "wrong # args: should be \"ow error print ?val?\""
}
eval ::OW::set_error_print $args
}
default {
error "bad option \"$opt\": must be level or print"
}
}
}
|