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