Fossil SCM

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

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button