OldUtil.tcl 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: OldUtil.tcl,v 1.5 2004/03/28 02:44:57 hobbs Exp $
  4. #
  5. # OldUtil.tcl -
  6. #
  7. # This is an undocumented file.
  8. # Are these features used in Tix : NO.
  9. # Should I use these features : NO.
  10. #
  11. # Copyright (c) 1993-1999 Ioi Kim Lam.
  12. # Copyright (c) 2000-2001 Tix Project Group.
  13. # Copyright (c) 2004 ActiveState
  14. #
  15. # See the file "license.terms" for information on usage and redistribution
  16. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  17. #
  18. proc setenv {name args} {
  19. global env
  20. if {[llength $args] == 1} {
  21. return [set env($name) [lindex $args 0]]
  22. } else {
  23. if {[info exists env($ename)] == 0} {
  24. bgerror "Error in setenv: "
  25. "environment variable \"$name\" does not exist"
  26. } else {
  27. return $env($name)
  28. }
  29. }
  30. }
  31. #----------------------------------------------------------------------
  32. #
  33. #
  34. # U T I L I T Y F U N C T I O N S F O R T I X
  35. #
  36. #
  37. #----------------------------------------------------------------------
  38. # RESET THE STRING IN THE ENTRY
  39. proc tixSetEntry {entry string} {
  40. set oldstate [lindex [$entry config -state] 4]
  41. $entry config -state normal
  42. $entry delete 0 end
  43. $entry insert 0 $string
  44. $entry config -state $oldstate
  45. }
  46. # GET THE FIRST SELECTED ITEM IN A LIST
  47. proc tixListGetSingle {lst} {
  48. set indices [$lst curselection]
  49. if {$indices != ""} {
  50. return [$lst get [lindex $indices 0]]
  51. } else {
  52. return ""
  53. }
  54. }
  55. #----------------------------------------------------------------------
  56. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  57. #----------------------------------------------------------------------
  58. proc tixDialogRestore {w {flag -geometry}} {
  59. global tixDPos
  60. if {[info exists tixDPos($w)]} {
  61. if {![winfo ismapped $w]} {
  62. wm geometry $w $tixDPos($w)
  63. wm deiconify $w
  64. }
  65. } elseif {$flag eq "-geometry"} {
  66. update
  67. set tixDPos($w) [winfo geometry $w]
  68. } else {
  69. update
  70. set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  71. }
  72. }
  73. #----------------------------------------------------------------------
  74. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  75. #----------------------------------------------------------------------
  76. proc tixDialogWithdraw {w {flag -geometry}} {
  77. global tixDPos
  78. if {[winfo ismapped $w]} {
  79. if {$flag eq "-geometry"} {
  80. set tixDPos($w) [winfo geometry $w]
  81. } else {
  82. set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  83. }
  84. wm withdraw $w
  85. }
  86. }
  87. #----------------------------------------------------------------------
  88. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  89. #----------------------------------------------------------------------
  90. proc tixDialogDestroy {w {flag -geometry}} {
  91. global tixDPos
  92. if {[winfo ismapped $w]} {
  93. if {$flag eq "-geometry"} {
  94. set tixDPos($w) [winfo geometry $w]
  95. } else {
  96. set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  97. }
  98. }
  99. destroy $w
  100. }