File: lazyset.tcl

package info (click to toggle)
tcllib 2.0%2Bdfsg-5
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 83,560 kB
  • sloc: tcl: 306,798; ansic: 14,272; sh: 3,035; xml: 1,766; yacc: 1,157; pascal: 881; makefile: 124; perl: 84; f90: 84; python: 33; ruby: 13; php: 11
file content (88 lines) | stat: -rw-r--r-- 1,725 bytes parent folder | download | duplicates (2)
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
#! /usr/bin/env tclsh

package require Tcl 8.5 9

namespace eval ::lazyset {}

proc ::lazyset::variable {args} {
	lassign [lrange $args end-1 end] varName commandPrefix
	set args [lrange $args 0 end-2]

	set appendArgs true
	foreach {arg val} $args {
		switch -exact -- $arg {
			"-array" {
				set isArray [expr {!!$val}]
			}
			"-appendArgs" {
				set appendArgs [expr {!!$val}]
			}
			default {
				error "Valid options -array, -appendArgs: Invalid option \"$arg\""
			}
		}
	}

	set trace [uplevel 1 [list trace info variable $varName]]
	if {$trace ne ""} {
		uplevel 1 [list [list trace remove variable $varName $trace]]
	}

	if {![info exists isArray]} {
		set isArray false
		if {[uplevel 1 [list ::array exists $varName]]} {
			set isArray true
		}
	}

	set finalCode ""
	if {$isArray} {
		append finalCode {
			set varname "$name1\($name2\)"
			if {[uplevel 1 [list info exists $varname]]} {
				return
			}
		}
	} else {
		append finalCode {
			set varname $name1
		}
	}

	if {$appendArgs} {
		append finalCode {
			set args [lrange $args 1 end]
		}
		if {$isArray} {
			append finalCode {
				append code " " [list $name1 $name2 {*}$args]
			}
		} else {
			append finalCode {
				append code " " [list $name1 {*}$args]
			}
		}
	}

	append finalCode {
		set result [uplevel 1 $code]

		uplevel 1 [list unset -nocomplain $varname]
		uplevel 1 [list set $varname $result]
	}

	set code [list apply [list {code name1 name2 args} $finalCode] $commandPrefix]

	if {$isArray} {
		uplevel 1 [list unset -nocomplain $varName]
		uplevel 1 [list ::array set $varName [list]]
	} else {
		uplevel 1 [list set $varName ""]
	}

	uplevel 1 [list trace add variable $varName read $code]

	return
}

package provide lazyset 1.1