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 / FileEnt.tcl < prev    next >
Text File  |  2002-01-24  |  8KB  |  274 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: FileEnt.tcl,v 1.3.2.3 2002/01/24 10:08:58 idiscovery Exp $
  4. #
  5. # FileEnt.tcl --
  6. #
  7. #     TixFileEntry Widget: an entry box for entering filenames.
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. tixWidgetClass tixFileEntry {
  17.     -classname TixFileEntry
  18.     -superclass tixLabelWidget
  19.     -method {
  20.     invoke filedialog update
  21.     }
  22.     -flag {
  23.     -activatecmd -command -dialogtype -disablecallback -disabledforeground
  24.     -filebitmap -selectmode -state -validatecmd -value -variable
  25.     }
  26.     -forcecall {
  27.     -variable
  28.     }
  29.     -static {
  30.     -filebitmap
  31.     }
  32.     -configspec {
  33.     {-activatecmd activateCmd ActivateCmd ""}
  34.     {-command command Command ""}
  35.     {-dialogtype dialogType DialogType ""}
  36.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  37.     {-disabledforeground disabledForeground DisabledForeground #303030}
  38.     {-filebitmap fileBitmap FileBitmap ""}
  39.     {-selectmode selectMode SelectMode normal}
  40.     {-state state State normal}
  41.     {-validatecmd validateCmd ValidateCmd ""}
  42.     {-value value Value ""}
  43.     {-variable variable Variable ""}
  44.     }
  45.     -default {
  46.     {*frame.borderWidth        2}
  47.     {*frame.relief            sunken}
  48.     {*Button.highlightThickness    0}
  49.     {*Entry.highlightThickness    0}
  50.     {*Entry.borderWidth         0}
  51.     }
  52. }
  53.  
  54. proc tixFileEntry:InitWidgetRec {w} {
  55.     upvar #0 $w data
  56.  
  57.     tixChainMethod $w InitWidgetRec
  58.     set data(varInited)      0
  59.  
  60.     if {$data(-filebitmap) == ""} {
  61.         set data(-filebitmap) [tix getbitmap openfile]
  62.     }
  63. }
  64.  
  65. proc tixFileEntry:ConstructFramedWidget {w frame} {
  66.     upvar #0 $w data
  67.  
  68.     tixChainMethod $w ConstructFramedWidget $frame
  69.  
  70.     set data(w:entry)  [entry  $frame.entry]
  71.     set data(w:button) [button $frame.button -bitmap $data(-filebitmap) \
  72.     -takefocus 0]
  73.     set data(entryfg) [$data(w:entry) cget -fg]
  74.  
  75.     pack $data(w:button) -side right -fill both
  76.     pack $data(w:entry)  -side left  -expand yes -fill both
  77. }
  78.  
  79. proc tixFileEntry:SetBindings {w} {
  80.     upvar #0 $w data
  81.  
  82.     tixChainMethod $w SetBindings
  83.  
  84.     $data(w:button) config -command [list tixFileEntry:OpenFile $w]
  85.     tixSetMegaWidget $data(w:entry) $w
  86.  
  87.     # If user press <return>, verify the value and call the -command
  88.     #
  89.     bind $data(w:entry) <Return> "tixFileEntry:invoke $w"
  90.     bind $data(w:entry) <KeyPress> {
  91.     if {[set [tixGetMegaWidget %W](-selectmode)] == "immediate"} {
  92.         tixFileEntry:invoke [tixGetMegaWidget %W]
  93.     }
  94.     }
  95.     bind $data(w:entry) <FocusOut>  {
  96.         if {"%d" == "NotifyNonlinear" || "%d" == "NotifyNonlinearVirtual"} {
  97.         tixFileEntry:invoke [tixGetMegaWidget %W]
  98.         }
  99.     }
  100.     bind $w <FocusIn> "focus $data(w:entry)"
  101. }
  102.  
  103. #----------------------------------------------------------------------
  104. #                           CONFIG OPTIONS
  105. #----------------------------------------------------------------------
  106. proc tixFileEntry:config-state {w value} {
  107.     upvar #0 $w data
  108.  
  109.     if {$value == "normal"} {
  110.     $data(w:button) config -state $value
  111.     $data(w:entry)  config -state $value -fg $data(entryfg)
  112.     catch {
  113.         $data(w:label)  config -fg $data(entryfg)
  114.     }
  115.     } else {
  116.     $data(w:button) config -state $value
  117.     $data(w:entry)  config -state $value -fg $data(-disabledforeground)
  118.     catch {
  119.         $data(w:label)  config -fg $data(-disabledforeground)
  120.     }
  121.     }
  122.  
  123.     return ""
  124. }
  125.  
  126. proc tixFileEntry:config-value {w value} {
  127.     tixFileEntry:SetValue $w $value
  128. }
  129.  
  130. proc tixFileEntry:config-variable {w arg} {
  131.     upvar #0 $w data
  132.  
  133.     if {[tixVariable:ConfigVariable $w $arg]} {
  134.        # The value of data(-value) is changed if tixVariable:ConfigVariable 
  135.        # returns true
  136.        tixFileEntry:SetValue $w $data(-value)
  137.     }
  138.     catch {
  139.     unset data(varInited)
  140.     }
  141.     set data(-variable) $arg
  142. }
  143.  
  144. #----------------------------------------------------------------------
  145. #                         User Commands
  146. #----------------------------------------------------------------------
  147. proc tixFileEntry:invoke {w} {
  148.     upvar #0 $w data
  149.  
  150.     if {[catch {$data(w:entry) index sel.first}] == 0} {
  151.     # THIS ENTRY OWNS SELECTION --> TURN IT OFF
  152.     #
  153.     $data(w:entry) select from end
  154.     $data(w:entry) select to   end
  155.     }
  156.  
  157.     tixFileEntry:SetValue $w [$data(w:entry) get]
  158. }
  159.  
  160. proc tixFileEntry:filedialog {w args} {
  161.     upvar #0 $w data
  162.  
  163.     if {$args == ""} {
  164.     return [tix filedialog $data(-dialogtype)]
  165.     } else {
  166.     return [eval [tix filedialog $data(-dialogtype)] $args]
  167.     }
  168. }
  169.  
  170. proc tixFileEntry:update {w} {
  171.     upvar #0 $w data
  172.  
  173.     if {"x[$data(w:entry) get]" != "x$data(-value)"} {
  174.     tixFileEntry:invoke $w
  175.     }
  176. }
  177. #----------------------------------------------------------------------
  178. #                       Internal Commands
  179. #----------------------------------------------------------------------
  180. proc tixFileEntry:OpenFile {w} {
  181.      upvar #0 $w data
  182.  
  183.      if {$data(-activatecmd) != ""} {
  184.      uplevel #0 $data(-activatecmd)
  185.      }
  186.  
  187.      switch -- $data(-dialogtype) tk_chooseDirectory {
  188.      set args [list -parent [winfo toplevel $w]]
  189.      if {[set initial $data(-value)] != ""} {
  190.          lappend args -initialdir $data(value)
  191.      }
  192.      set retval [eval tk_chooseDirectory $args]
  193.  
  194.      if {$retval != ""} {tixFileEntry:SetValue $w [file native $retval]}
  195.      } tk_getOpenFile - tk_getSaveFile {
  196.      set args [list -parent [winfo toplevel $w]]
  197.  
  198.      if {[set initial [$data(w:entry) get]] != ""} {
  199.          switch -glob -- $initial *.py {
  200.          set types [list {"Python Files" {.py .pyw}} {"All Files" *}]
  201.          } *.txt {
  202.          set types [list {"Text Files" .txt} {"All Files" *}]
  203.          } *.tcl {
  204.          set types [list {"Tcl Files" .tcl} {"All Files" *}]
  205.          } * - default {
  206.          set types [list {"All Files" *}]
  207.          }
  208.          if {[file isfile $initial]} {
  209.          lappend args -initialdir [file dir $initial] \
  210.              -initialfile $initial
  211.          } elseif {[file isdir $initial]} {
  212.          lappend args -initialdir $initial
  213.          }
  214.      } else {
  215.          set types [list {"All Files" *}]
  216.      }
  217.      lappend args -filetypes $types
  218.  
  219.      set retval [eval $data(-dialogtype) $args]
  220.      if {$retval != ""} {tixFileEntry:SetValue $w [file native $retval]}
  221.      } default {
  222.      set filedlg [tix filedialog $data(-dialogtype)]
  223.  
  224.      $filedlg config -parent [winfo toplevel $w] \
  225.          -command [list tixFileEntry:FileDlgCallback $w]
  226.  
  227.      focus $data(w:entry)
  228.  
  229.      $filedlg popup
  230.      }
  231. }
  232.  
  233. proc tixFileEntry:FileDlgCallback {w args} {
  234.     set filename [tixEvent flag V]
  235.  
  236.     tixFileEntry:SetValue $w $filename
  237. }
  238.  
  239. proc tixFileEntry:SetValue {w value} {
  240.     upvar #0 $w data
  241.  
  242.     if {$data(-validatecmd) != ""} {
  243.     set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
  244.     }
  245.  
  246.     if {$data(-state) == "normal"} {
  247.     $data(w:entry) delete 0 end
  248.     $data(w:entry) insert 0 $value
  249.     $data(w:entry) xview end
  250.     }
  251.  
  252.     set data(-value) $value
  253.  
  254.     tixVariable:UpdateVariable $w
  255.  
  256.     if {$data(-command) != "" && !$data(-disablecallback)} {
  257.     if {![info exists data(varInited)]} {
  258.         set bind(specs) ""
  259.         tixEvalCmdBinding $w $data(-command) bind $value
  260.     }
  261.     }
  262. }
  263.  
  264. proc tixFileEntry:Destructor {w} {
  265.     upvar #0 $w data
  266.  
  267.     tixUnsetMegaWidget $data(w:entry)
  268.     tixVariable:DeleteVariable $w
  269.  
  270.     # Chain this to the superclass
  271.     #
  272.     tixChainMethod $w Destructor
  273. }
  274.