home *** CD-ROM | disk | FTP | other *** search
/ Freesoft 1999 February / Freesoft_1999-02_cd.bin / Recenz / Utility / DisplayDoctorLinux / scitech-display-doctor-1.0beta-3.i386.rpm / scitech-display-doctor-1.0beta.3.cpio.gz / scitech-display-doctor-1.0beta.3.cpio / usr / lib / nucleus / XF86Setup / tcllib / misc.tcl < prev    next >
Text File  |  1998-09-19  |  4KB  |  145 lines
  1. # $XConsortium: misc.tcl /main/1 1996/09/21 14:15:06 kaleb $
  2. #
  3. #
  4. #
  5. #
  6. # $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/misc.tcl,v 3.4 1996/12/27 06:55:01 dawes Exp $
  7. #
  8. # Copyright 1996 by Joseph V. Moss <joe@XFree86.Org>
  9. #
  10. # See the file "LICENSE" for information regarding redistribution terms,
  11. # and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13.  
  14. #
  15. # Misc routines that could be useful outside XF86Setup
  16. #
  17.  
  18. # remove all whitespace from the string
  19.  
  20. proc zap_white { str } {
  21.     regsub -all "\[ \t\n\]+" $str {} str
  22.     return $str
  23. }
  24.  
  25.  
  26. # replace all sequences of whitespace with a single space
  27.  
  28. proc squash_white { str } {
  29.     regsub -all "\[ \t\n\]+" $str { } str
  30.     return $str
  31. }
  32.  
  33.  
  34. # implement do { ... } while loop
  35.  
  36. proc do { commands while expression } {
  37.     uplevel $commands
  38.     while { [uplevel [list expr $expression]] } {
  39.         uplevel $commands
  40.     }
  41. }
  42.  
  43.  
  44. # break a long line into shorter lines
  45.  
  46. proc parafmt { llen string } {
  47.     set string [string trim [squash_white $string]]
  48.     set retval ""
  49.     while { [string length $string] > $llen } {
  50.         set tmp [string range $string 0 $llen]
  51.         #puts stderr "'$string'$tmp'$retval'"
  52.         set pos [string last " " $tmp]
  53.         if { $pos == -1 } {
  54.             append retval [string range $string 0 [expr $llen-1]]\n
  55.             set string [string range $string $llen end]
  56.             continue
  57.         }
  58.         if { $pos == 0 } {
  59.             append retval [string range $string 1 [expr $llen]]\n
  60.             set string [string range $string $llen end]
  61.             continue
  62.         }
  63.         if { $pos == $llen-1 } {
  64.             append retval [string range $string 0 [expr $llen-2]]\n
  65.             set string [string range $string $llen end]
  66.             continue
  67.         }
  68.         append retval [string range $tmp 0 [expr $pos-1]]\n
  69.         set string [string range $string [expr $pos+1] end]
  70.     }
  71.     #return [string trimright $retval \n]\n$string
  72.     return $retval$string
  73. }
  74.  
  75.  
  76. #  convert the window name to a form that can be used as a prefix to
  77. #    to the window names of child windows
  78. #  - basically, avoid double dot
  79.  
  80. proc winpathprefix { w } {
  81.     if ![string compare . $w] { return "" }
  82.     return $w
  83. }
  84.  
  85.  
  86. # return a (sorted) list with duplicate elements removed
  87. # uses the same syntax as lsort
  88.  
  89. proc lrmdups { args } {
  90.     set inlist [eval lsort $args]
  91.     set retlist ""
  92.     set lastelem "nomatch[lindex $inlist 0]"
  93.     foreach elem $inlist {
  94.         if [string compare $lastelem $elem] {
  95.             lappend retlist $elem
  96.             set lastelem $elem
  97.         }
  98.     }
  99.     return $retlist
  100. }
  101.  
  102.  
  103. # return the name of the file to which the given symlink points
  104. # if the name is a relative path, convert it to a full path
  105. # (assumes the symlink is given as a full path)
  106.  
  107. proc readlink { linkname } {
  108.     set fname [file readlink $linkname]
  109.     if { ![string length $fname] 
  110.             || ![string compare [string index $fname 0] /] } {
  111.         return $fname
  112.     }
  113.     set path [file dirname $linkname]/$fname
  114.     regsub -all {/\./} $path / path
  115.     return $path
  116. }
  117.  
  118.  
  119. #simple random number generator
  120.  
  121. proc random {args} {
  122.         global RNG_seed
  123.     
  124.         set max 259200
  125.         set argcnt [llength $args]
  126.         if { $argcnt < 1 || $argcnt > 2 } {
  127.             error "wrong # args: random limit | seed ?seedval?"
  128.         }
  129.         if ![string compare [lindex $args 0] seed] {
  130.             if { $argcnt == 2 } {
  131.                 set RNG_seed [expr [lindex $args 1]%$max]
  132.             } else {
  133.                 set RNG_seed [expr \
  134.                     ([pid]+[clock clicks])%$max]
  135.             }
  136.             return
  137.         }
  138.         if ![info exists RNG_seed] {
  139.             set RNG_seed [expr ([pid]+[clock clicks])%$max]
  140.         }
  141.         set RNG_seed [expr ($RNG_seed*7141+54773) % $max]
  142.         return [expr int(double($RNG_seed)*[lindex $args 0]/$max)]
  143. }
  144.  
  145.