|
1
|
## -*- tcl -*- |
|
2
|
# # ## ### ##### ######## ############# ##################### |
|
3
|
## Copyright (c) 2007-2008 Andreas Kupries. |
|
4
|
# |
|
5
|
# This software is licensed as described in the file LICENSE, which |
|
6
|
# you should have received as part of this distribution. |
|
7
|
# |
|
8
|
# This software consists of voluntary contributions made by many |
|
9
|
# individuals. For exact contribution history, see the revision |
|
10
|
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
11
|
# # ## ### ##### ######## ############# ##################### |
|
12
|
|
|
13
|
## Utilities for various things: text formatting, max, ... |
|
14
|
|
|
15
|
# # ## ### ##### ######## ############# ##################### |
|
16
|
## Requirements |
|
17
|
|
|
18
|
package require Tcl 8.4 ; # Required runtime |
|
19
|
|
|
20
|
# # ## ### ##### ######## ############# ##################### |
|
21
|
## |
|
22
|
|
|
23
|
namespace eval ::vc::tools::misc { |
|
24
|
# # ## ### ##### ######## ############# |
|
25
|
## Public API, Methods |
|
26
|
|
|
27
|
# Choose singular vs plural forms of a word based on a number. |
|
28
|
|
|
29
|
proc sp {n singular {plural {}}} { |
|
30
|
if {$n == 1} {return $singular} |
|
31
|
if {$plural eq ""} {set plural ${singular}s} |
|
32
|
return $plural |
|
33
|
} |
|
34
|
|
|
35
|
# As above, with the number automatically put in front of the |
|
36
|
# string. |
|
37
|
|
|
38
|
proc nsp {n singular {plural {}}} { |
|
39
|
return "$n [sp $n $singular $plural]" |
|
40
|
} |
|
41
|
|
|
42
|
# Find maximum/minimum in a list. |
|
43
|
|
|
44
|
proc max {list} { |
|
45
|
set max -1 |
|
46
|
foreach e $list { |
|
47
|
if {$e < $max} continue |
|
48
|
set max $e |
|
49
|
} |
|
50
|
return $max |
|
51
|
} |
|
52
|
|
|
53
|
proc min {list} { |
|
54
|
set min {} |
|
55
|
foreach e $list { |
|
56
|
if {$min == {}} { |
|
57
|
set min $e |
|
58
|
} elseif {$e > $min} continue |
|
59
|
set min $e |
|
60
|
} |
|
61
|
return $min |
|
62
|
} |
|
63
|
|
|
64
|
proc max2 {a b} { |
|
65
|
if {$a > $b} { return $a } |
|
66
|
return $b |
|
67
|
} |
|
68
|
|
|
69
|
proc min2 {a b} { |
|
70
|
if {$a < $b} { return $a } |
|
71
|
return $b |
|
72
|
} |
|
73
|
|
|
74
|
proc ldelete {lv item} { |
|
75
|
upvar 1 $lv list |
|
76
|
set pos [lsearch -exact $list $item] |
|
77
|
if {$pos < 0} return |
|
78
|
set list [lreplace $list $pos $pos] |
|
79
|
return |
|
80
|
} |
|
81
|
|
|
82
|
# Delete item from list by name |
|
83
|
|
|
84
|
proc striptrailingslash {path} { |
|
85
|
# split and rejoin gets rid of a traling / character. |
|
86
|
return [eval [linsert [file split $path] 0 ::file join]] |
|
87
|
} |
|
88
|
|
|
89
|
# The windows filesystem is storing file-names case-sensitive, but |
|
90
|
# matching is case-insensitive. That is a problem as without |
|
91
|
# precaution the two files Attic/X,v and x,v may be mistakenly |
|
92
|
# identified as the same file. A similar thing can happen for |
|
93
|
# files and directories. To prevent such mistakes we need commands |
|
94
|
# which do case-sensitive file matching even on systems which do |
|
95
|
# not perform this natively. These are below. |
|
96
|
|
|
97
|
if {$tcl_platform(platform) eq "windows"} { |
|
98
|
# We use glob to get the list of files (with proper case in |
|
99
|
# the names) to perform our own, case-sensitive matching. WE |
|
100
|
# use 8.5 features where possible, for clarity. |
|
101
|
|
|
102
|
if {[package vsatisfies [package present Tcl] 8.5]} { |
|
103
|
proc fileexists_cs {path} { |
|
104
|
set dir [::file dirname $path] |
|
105
|
set file [::file tail $path] |
|
106
|
return [expr {$file in [glob -nocomplain -tail -directory $dir *]}] |
|
107
|
} |
|
108
|
|
|
109
|
proc fileisdir_cs {path} { |
|
110
|
set dir [::file dirname $path] |
|
111
|
set file [::file tail $path] |
|
112
|
return [expr {$file in [glob -nocomplain -types d -tail -directory $dir *]}] |
|
113
|
} |
|
114
|
} else { |
|
115
|
proc fileexists_cs {path} { |
|
116
|
set dir [::file dirname $path] |
|
117
|
set file [::file tail $path] |
|
118
|
return [expr {[lsearch [glob -nocomplain -tail -directory $dir *] $file] >= 0}] |
|
119
|
} |
|
120
|
|
|
121
|
proc fileisdir_cs {path} { |
|
122
|
set dir [::file dirname $path] |
|
123
|
set file [::file tail $path] |
|
124
|
return [expr {[lsearch [glob -nocomplain -types d -tail -directory $dir *] $file] >= 0}] |
|
125
|
} |
|
126
|
} |
|
127
|
} else { |
|
128
|
proc fileexists_cs {path} { return [file exists $path] } |
|
129
|
proc fileisdir_cs {path} { return [file isdirectory $path] } |
|
130
|
} |
|
131
|
|
|
132
|
# # ## ### ##### ######## ############# |
|
133
|
} |
|
134
|
|
|
135
|
namespace eval ::vc::tools::misc { |
|
136
|
namespace export sp nsp max min max2 min2 ldelete |
|
137
|
namespace export striptrailingslash fileexists_cs fileisdir_cs |
|
138
|
} |
|
139
|
|
|
140
|
# ----------------------------------------------------------------------------- |
|
141
|
# Ready |
|
142
|
|
|
143
|
package provide vc::tools::misc 1.0 |
|
144
|
return |
|
145
|
|