diff options
Diffstat (limited to 'tools/cvs2fossil/lib/misc.tcl')
| -rw-r--r-- | tools/cvs2fossil/lib/misc.tcl | 144 |
1 files changed, 144 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/misc.tcl b/tools/cvs2fossil/lib/misc.tcl new file mode 100644 index 0000000..aa75ab3 --- /dev/null +++ b/tools/cvs2fossil/lib/misc.tcl @@ -0,0 +1,144 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ##################### +## Copyright (c) 2007-2008 Andreas Kupries. +# +# This software is licensed as described in the file LICENSE, which +# you should have received as part of this distribution. +# +# This software consists of voluntary contributions made by many +# individuals. For exact contribution history, see the revision +# history and logs, available at http://fossil-scm.hwaci.com/fossil +# # ## ### ##### ######## ############# ##################### + +## Utilities for various things: text formatting, max, ... + +# # ## ### ##### ######## ############# ##################### +## Requirements + +package require Tcl 8.4 ; # Required runtime + +# # ## ### ##### ######## ############# ##################### +## + +namespace eval ::vc::tools::misc { + # # ## ### ##### ######## ############# + ## Public API, Methods + + # Choose singular vs plural forms of a word based on a number. + + proc sp {n singular {plural {}}} { + if {$n == 1} {return $singular} + if {$plural eq ""} {set plural ${singular}s} + return $plural + } + + # As above, with the number automatically put in front of the + # string. + + proc nsp {n singular {plural {}}} { + return "$n [sp $n $singular $plural]" + } + + # Find maximum/minimum in a list. + + proc max {list} { + set max -1 + foreach e $list { + if {$e < $max} continue + set max $e + } + return $max + } + + proc min {list} { + set min {} + foreach e $list { + if {$min == {}} { + set min $e + } elseif {$e > $min} continue + set min $e + } + return $min + } + + proc max2 {a b} { + if {$a > $b} { return $a } + return $b + } + + proc min2 {a b} { + if {$a < $b} { return $a } + return $b + } + + proc ldelete {lv item} { + upvar 1 $lv list + set pos [lsearch -exact $list $item] + if {$pos < 0} return + set list [lreplace $list $pos $pos] + return + } + + # Delete item from list by name + + proc striptrailingslash {path} { + # split and rejoin gets rid of a traling / character. + return [eval [linsert [file split $path] 0 ::file join]] + } + + # The windows filesystem is storing file-names case-sensitive, but + # matching is case-insensitive. That is a problem as without + # precaution the two files Attic/X,v and x,v may be mistakenly + # identified as the same file. A similar thing can happen for + # files and directories. To prevent such mistakes we need commands + # which do case-sensitive file matching even on systems which do + # not perform this natively. These are below. + + if {$tcl_platform(platform) eq "windows"} { + # We use glob to get the list of files (with proper case in + # the names) to perform our own, case-sensitive matching. WE + # use 8.5 features where possible, for clarity. + + if {[package vsatisfies [package present Tcl] 8.5]} { + proc fileexists_cs {path} { + set dir [::file dirname $path] + set file [::file tail $path] + return [expr {$file in [glob -nocomplain -tail -directory $dir *]}] + } + + proc fileisdir_cs {path} { + set dir [::file dirname $path] + set file [::file tail $path] + return [expr {$file in [glob -nocomplain -types d -tail -directory $dir *]}] + } + } else { + proc fileexists_cs {path} { + set dir [::file dirname $path] + set file [::file tail $path] + return [expr {[lsearch [glob -nocomplain -tail -directory $dir *] $file] >= 0}] + } + + proc fileisdir_cs {path} { + set dir [::file dirname $path] + set file [::file tail $path] + return [expr {[lsearch [glob -nocomplain -types d -tail -directory $dir *] $file] >= 0}] + } + } + } else { + proc fileexists_cs {path} { return [file exists $path] } + proc fileisdir_cs {path} { return [file isdirectory $path] } + } + + # # ## ### ##### ######## ############# +} + +namespace eval ::vc::tools::misc { + namespace export sp nsp max min max2 min2 ldelete + namespace export striptrailingslash fileexists_cs fileisdir_cs +} + +# ----------------------------------------------------------------------------- +# Ready + +package provide vc::tools::misc 1.0 +return |
