blob: 6b0a54db7ba02801c823ce2092cd3c457925aa33 (
plain)
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
|
# $XConsortium: misc.tcl /main/1 1996/09/21 14:15:06 kaleb $
#
#
#
#
# $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/misc.tcl,v 3.3 1996/08/24 12:51:38 dawes Exp $
#
# Copyright 1996 by Joseph V. Moss <joe@XFree86.Org>
#
# See the file "LICENSE" for information regarding redistribution terms,
# and for a DISCLAIMER OF ALL WARRANTIES.
#
#
# Misc routines that could be useful outside XF86Setup
#
# remove all whitespace from the string
proc zap_white { str } {
regsub -all "\[ \t\n\]+" $str {} str
return $str
}
# replace all sequences of whitespace with a single space
proc squash_white { str } {
regsub -all "\[ \t\n\]+" $str { } str
return $str
}
# implement do { ... } while loop
proc do { commands while expression } {
uplevel $commands
while { [uplevel [list expr $expression]] } {
uplevel $commands
}
}
# break a long line into shorter lines
proc parafmt { llen string } {
set string [string trim [squash_white $string]]
set retval ""
while { [string length $string] > $llen } {
set tmp [string range $string 0 $llen]
#puts stderr "'$string'$tmp'$retval'"
set pos [string last " " $tmp]
if { $pos == -1 } {
append retval [string range $string 0 [expr $llen-1]]\n
set string [string range $string $llen end]
continue
}
if { $pos == 0 } {
append retval [string range $string 1 [expr $llen]]\n
set string [string range $string $llen end]
continue
}
if { $pos == $llen-1 } {
append retval [string range $string 0 [expr $llen-2]]\n
set string [string range $string $llen end]
continue
}
append retval [string range $tmp 0 [expr $pos-1]]\n
set string [string range $string [expr $pos+1] end]
}
#return [string trimright $retval \n]\n$string
return $retval$string
}
# convert the window name to a form that can be used as a prefix to
# to the window names of child windows
# - basically, avoid double dot
proc winpathprefix { w } {
if ![string compare . $w] { return "" }
return $w
}
# return a (sorted) list with duplicate elements removed
# uses the same syntax as lsort
proc lrmdups { args } {
set inlist [eval lsort $args]
set retlist ""
set lastelem "nomatch[lindex $inlist 0]"
foreach elem $inlist {
if [string compare $lastelem $elem] {
lappend retlist $elem
set lastelem $elem
}
}
return $retlist
}
# return the name of the file to which the given symlink points
# if the name is a relative path, convert it to a full path
# (assumes the symlink is given as a full path)
proc readlink { linkname } {
set fname [file readlink $linkname]
if { ![string length $fname]
|| ![string compare [string index $fname 0] /] } {
return $fname
}
set path [file dirname $linkname]/$fname
regsub -all {/\./} $path / path
return $path
}
#simple random number generator
proc random {args} {
global RNG_seed
set max 259200
set argcnt [llength $args]
if { $argcnt < 1 || $argcnt > 2 } {
error "wrong # args: random limit | seed ?seedval?"
}
if ![string compare [lindex $args 0] seed] {
if { $argcnt == 2 } {
set RNG_seed [expr [lindex $args 1]%$max]
} else {
set RNG_seed [expr \
([pid]+[clock clicks])%$max]
}
return
}
if ![info exists RNG_seed] {
set RNG_seed [expr ([pid]+[clock clicks])%$max]
}
set RNG_seed [expr ($RNG_seed*7141+54773) % $max]
return [expr int(double($RNG_seed)*[lindex $args 0]/$max)]
}
|
