Artifact c7b90ad47b38f04801c2df2feff1d87a0dae6942

File tools/cvs2fossil/lib/misc.tcl part of check-in [edc46651c7] - Moved the new case-sensitive file checking code into the misc package with descriptive command names, to recapture clarity of code at the calling places. by aku on 2008-01-29 04:05:10.

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 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_ci {path} {
		set dir  [::file dirname $path]
		set file [::file tail    $path]
		return [expr {$file in [glob -nocomplain -tail -directory $dir *]}]
	    }

	    proc fileisdir_ci {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_ci {path} {
		set dir  [::file dirname $path]
		set file [::file tail    $path]
		return [expr {[lsearch [glob -nocomplain -tail -directory $dir *] $file] >= 0}]
	    }

	    proc fileisdir_ci {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_ci {path} { return [file exists      $path] }
	proc fileisdir_ci  {path} { return [file isdirectory $path] }
    }

    # # ## ### ##### ######## #############
}

namespace eval ::vc::tools::misc {
    namespace export sp nsp max min max2 min2 ldelete
    namespace export striptrailingslash fileexists_ci fileisdir_ci
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::tools::misc 1.0
return