Posted to tcl by patthoyts at Thu Jul 27 09:37:22 GMT 2006view raw

  1. # From tkabber - plugins/iq/version.tcl
  2.  
  3. proc try_linux_version {distr file flag} {
  4. global linux_distribution
  5.  
  6. if {![file exists $file]} {
  7. return
  8. }
  9. if {![file readable $file]} {
  10. set linux_distribution $distr
  11. return
  12. }
  13. set fd [open $file r]
  14. set content [read $fd]
  15. close $fd
  16. set last [string first "\n" $content]
  17. if {$last < 0} {
  18. set last end
  19. } else {
  20. set last [expr {$last - 1}]
  21. }
  22. set line [string range $content 0 $last]
  23.  
  24. switch -- $flag {
  25. file { set linux_distribution $line }
  26. append { set linux_distribution "$distr $line" }
  27. }
  28. }
  29.  
  30. proc guess_linux_distribution {} {
  31. global linux_distribution
  32.  
  33. if {[info exists linux_distribution]} {
  34. return $linux_distribution
  35. }
  36.  
  37. foreach {distr file flag} { \
  38. "SuSE Linux" /etc/SuSE-release file \
  39. "Debian GNU/Linux" /etc/debian_version append \
  40. "ASPLinux" /etc/asplinux-release file \
  41. "Alt Linux" /etc/altlinux-release file \
  42. "PLD Linux" /etc/pld-release file \
  43. "Gentoo Linux" /etc/gentoo-release file \
  44. "Mandrake Linux" /etc/mandrake-release file \
  45. "RedHat Linux" /etc/redhat-release file \
  46. "Conectiva Linux" /etc/conectiva-release file \
  47. "Slackware Linux" /etc/slackware-version append } {
  48.  
  49. try_linux_version $distr $file $flag
  50.  
  51. if {[info exists linux_distribution]} {
  52. return $linux_distribution
  53. }
  54. }
  55.  
  56. set linux_distribution Linux
  57. return $linux_distribution
  58. }