File: registry.tcl

package info (click to toggle)
tcllib 1.20%2Bdfsg-1
  • links: PTS
  • area: main
  • in suites: bullseye
  • size: 68,064 kB
  • sloc: tcl: 216,842; ansic: 14,250; sh: 2,846; xml: 1,766; yacc: 1,145; pascal: 881; makefile: 107; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (59 lines) | stat: -rw-r--r-- 1,187 bytes parent folder | download | duplicates (12)
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
# -*- tcl -*-
# (C) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
##
# ###

getpackage pregistry registry/registry.tcl

namespace eval ::sak::registry {}

proc ::sak::registry::local {args} {
    return [uplevel 1 [linsert $args 0 [Setup]]]
    # return <$_local {expand}$args>
}

proc ::sak::registry::Setup {} {
    variable _local
    variable state
    variable statedir

    if {![file exists $statedir]} {
	file mkdir $statedir
    }

    if {$_local == {}} {
	set _local [pregistry %AUTO% \
		-tie [list file $state]]
    }

    return $_local
}

proc ::sak::registry::Refresh {} {
    variable _local
    $_local destroy
    set _local {}
    Setup
    return
}

namespace eval ::sak::registry {
    variable _here    [file dirname [info script]]

    variable statedir [file join ~ .Tcllib]
    variable state    [file join $statedir Registry]
    variable _local   {}
}

##
# ###

package provide sak::registry 1.0

# ###
## Data structures
#
## Core is a tree (struct::tree), keys are lists, mapping to a node,
## starting from the root. Attributes are node attributes. A prefix is
## used to distinguish them from the attributes used for internal
## purposes.