/[webpac]/openisis/current/tcl/lib/mlcm.prof.tcl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/tcl/lib/mlcm.prof.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (18 years, 5 months ago) by dpavlin
File MIME type: application/x-tcl
File size: 1481 byte(s)
initial import of openisis 0.9.0 vendor drop

1
2 package provide mlcm::profile 0.1
3
4 namespace eval mlcm::profile {
5
6 array set _all {}
7
8 # gets an "active" variable
9 proc _getA { rec var } {
10 if [catch {set val [$rec get "a$var"]}] {
11 set val [$rec get $var]
12 if [llength $val] {
13 set val [lindex $val 0]
14 $rec set "a$var" $val
15 return $val
16 }
17 error "have no $var"
18 }
19 return $val
20 }
21
22 # sets an "active" variable
23 proc _setA { rec var val } {
24 if {0 > [lsearch [$rec get $var] "a$var"]} {
25 error "unknown $var $val"
26 }
27 $rec set "a$var" $val
28 return $val
29 }
30
31 set _body {
32 set len [llength $args]
33 switch -regexp -- [lindex $args 0] {
34 db
35 { if {2 > $len} {
36 return [$rec get {adb {}}]
37 }
38 set adb [lindex $args 1]
39 if {0 > [lsearch [$rec get db] $adb]} {
40 error "unknown db $adb"
41 }
42 $rec set adb $adb
43 # set astub
44 return $adb
45 }
46 stub
47 {
48 return [$rec get {astub {}}]
49 }
50 menu|lang
51 { if {2 > $len} {
52 return [_getA $rec [lindex $args 0]]
53 }
54 return [_setA $rec [lindex $args 0] [lindex $args 1]]
55 }
56 .*
57 { return [eval $rec $args]
58 }
59 }
60 }
61
62 proc addentry {name rec} {
63 variable _all
64 if [catch {set cfg $_all($name)}] {
65 set _all($name) [set cfg [
66 openIsisRec {} -fdt $mlcm::meta::fdtProf]]
67 }
68 openIsis::util::deepcopy $rec $cfg
69 return $cfg
70 }
71
72 proc activate name {
73 variable _all
74 variable _body
75 set rec $_all($name)
76 set cmd p0
77 proc $cmd args "
78 variable _all
79 set rec $rec
80 $_body
81 "
82 return mlcm::profile::$cmd
83 }
84 }
85

  ViewVC Help
Powered by ViewVC 1.1.26