home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / OldUtil.tcl < prev    next >
Text File  |  2001-11-03  |  6KB  |  229 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: OldUtil.tcl,v 1.3.2.1 2001/11/03 07:16:33 idiscovery 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. #
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17.  
  18. proc setenv {name args} {
  19.     global env
  20.  
  21.     if {[llength $args] == 1} {
  22.         return [set env($name) [lindex $args 0]]
  23.     } else {
  24.         if {[info exists env($ename)] == 0} {
  25.             bgerror "Error in setenv: "
  26.                     "environment variable \"$name\" does not exist"
  27.         } else {
  28.             return $env($name)
  29.         }
  30.     }
  31. }
  32. #----------------------------------------------------------------------
  33. #
  34. #
  35. #           U T I L I T Y   F U N C T I O N S  F O R   T I X 
  36. #
  37. #
  38. #----------------------------------------------------------------------
  39.  
  40. # RESET THE STRING IN THE ENTRY
  41. proc tixSetEntry {entry string} {
  42.     set oldstate [lindex [$entry config -state] 4]
  43.     $entry config -state normal
  44.     $entry delete 0 end
  45.     $entry insert 0 $string
  46.     $entry config -state $oldstate
  47. }
  48.  
  49. # GET THE FIRST SELECTED ITEM IN A LIST
  50. proc tixListGetSingle {lst} {
  51.     set indices [$lst curselection]
  52.     if {$indices != "" } {
  53.     return [$lst get [lindex $indices 0]]
  54.     } else {
  55.     return ""
  56.     }
  57. }
  58.  
  59. #----------------------------------------------------------------------
  60. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  61. #----------------------------------------------------------------------
  62. proc tixDialogRestore {w {flag -geometry}} {
  63.     global tixDPos
  64.  
  65.     if {[info exists tixDPos($w)]} {
  66.     if {![winfo ismapped $w]} {
  67.         wm geometry $w $tixDPos($w)
  68.         wm deiconify $w
  69.     }
  70.     } elseif {$flag == "-geometry"} {
  71.     update
  72.     set tixDPos($w) [winfo geometry $w]
  73.     } else {
  74.     update
  75.     set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  76.     }
  77. }
  78. #----------------------------------------------------------------------
  79. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  80. #----------------------------------------------------------------------
  81. proc tixDialogWithdraw {w {flag -geometry}} {
  82.     global tixDPos
  83.  
  84.     if {[winfo ismapped $w]} {
  85.     if {$flag == "-geometry"} {
  86.         set tixDPos($w) [winfo geometry $w]
  87.     } else {
  88.         set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  89.     }
  90.     wm withdraw $w
  91.     }
  92. }
  93. #----------------------------------------------------------------------
  94. # RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
  95. #----------------------------------------------------------------------
  96. proc tixDialogDestroy {w {flag -geometry}} {
  97.     global tixDPos
  98.  
  99.     if {[winfo ismapped $w]} {
  100.     if {$flag == "-geometry"} {
  101.         set tixDPos($w) [winfo geometry $w]
  102.     } else {
  103.         set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
  104.     }
  105.     }
  106.     destroy $w
  107. }
  108.  
  109. # Obsolete
  110. #
  111. proc tixQueryAppResource {name class default} {
  112.  
  113.     set value [option get . $name $class]
  114.     if {$value == ""} {
  115.     return $default
  116.     } else {
  117.     return $value
  118.     }    
  119. }
  120. proc tixCreateToplevel {w {type -mapped}} {
  121.     upvar #0 $w data
  122.  
  123.     toplevel $w
  124.     wm minsize $w 0 0
  125.     if {$type == "-withdrawn"} {
  126.     wm withdraw $w
  127.     }
  128.  
  129.     bind $w <Destroy>    [bind Toplevel <Destroy>]
  130.     bind $w <Map>        [bind Toplevel <Map>]
  131.     bind $w <Unmap>      [bind Toplevel <Unmap>]
  132.     bind $w <Visibility> [bind Toplevel <Visibility>]
  133.     bind $w <Destroy>    "+_tixToplevelDestroy $w"
  134.     bind $w <Map>        "+_tixToplevelMap $w"
  135.     bind $w <Unmap>      "+_tixToplevelUnmap $w"
  136.     bind $w <Visibility> "+_tixToplevelVisibility $w"
  137. }
  138.  
  139. proc _tixToplevelDestroy {w} {
  140.     upvar #0 $w data
  141.  
  142.     unset data
  143. }
  144.  
  145. proc _tixToplevelUnmap {w} {
  146.     upvar #0 $w data
  147.  
  148.     foreach dlg $data(dialogs) {
  149.     set data($dlg,geom) [winfo geometry $dlg]
  150.     wm withdraw $dlg
  151.     }
  152. }
  153.  
  154. proc _tixToplevelMap {w} {
  155.     upvar #0 $w data
  156.  
  157.     foreach dlg $data(dialogs) {
  158.     wm geometry $dlg $data($dlg,geom)
  159.     wm deiconify $dlg
  160.     }
  161. }
  162.  
  163. proc _tixToplevelVisibility {w} {
  164.     upvar #0 $w data
  165.  
  166.     foreach dlg $data(dialogs) {
  167.     raise $dlg $w
  168.     }
  169. }
  170.  
  171. proc tixCreateDialogShell {w {type -mapped}} {
  172.     toplevel $w
  173.     set parent [winfo parent $w]
  174.     upvar #0 $parent data
  175.  
  176.     wm minsize $w 0 0
  177.     wm withdraw $w
  178.     update
  179.     mwm transfor $w [winfo parent $w]
  180.     lappend data(dialogs) $w
  181.     bind $w <Destroy> "_tixDialogDestroy $w"
  182.  
  183.     if {$type != "-withdrawn"} {
  184.     wm deiconify $w
  185.     }
  186. }
  187.  
  188. proc _tixDialogDestroy {w} {
  189.     set parent [winfo parent $w]
  190.     upvar #0 $parent data
  191.  
  192.     catch {unset $data($w,geom)}
  193. }
  194.  
  195.  
  196. proc _tixInitMainWindow {w} {
  197.     upvar #0 $w data
  198.  
  199.     set data(dialogs) ""
  200.  
  201.     bind $w <Destroy>    +[bind Toplevel <Destroy>]
  202.     bind $w <Map>        +[bind Toplevel <Map>]
  203.     bind $w <Unmap>      +[bind Toplevel <Unmap>]
  204.     bind $w <Visibility> +[bind Toplevel <Visibility>]
  205.     bind $w <Destroy>    "+_tixToplevelDestroy $w"
  206.     bind $w <Map>        "+_tixToplevelMap $w"
  207.     bind $w <Unmap>      "+_tixToplevelUnmap $w"
  208.     bind $w <Visibility> "+_tixToplevelVisibility $w"
  209. }
  210.  
  211. # The "mwm" command comes from tkmwm, a cousin package of Tix
  212. # If this wish does not support mwm, the following line prevent code
  213. # that uses "mwm" from breaking.
  214. #
  215. if {[info commands mwm] == ""} {
  216.     proc mwm {args} {}
  217. }
  218.  
  219. #----------------------------------------------------------------------
  220. # Automatically initialization call
  221. #----------------------------------------------------------------------
  222.  
  223. # This has been disabled
  224.  
  225. if 0 {
  226.     _tixInitMainWindow .
  227. }
  228.  
  229.