/[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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

1 dpavlin 237
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