git.oblomov.eu Git - wine/blob - tools/wineconf.libs/getfilename.tcl

   1 #!/usr/bin/wish
   2 #############################################################################
   3 # Visual Tcl v1.07 Project
   4 #
   5
   6 #################################
   7 # GLOBAL VARIABLES
   8 #
   9 global widget;
  10 #################################
  11
  12 proc TkW:GetFileName {message opt1 opt2 searchtype} {
  13 global OK MSG_title WAITfilename TKW GetFileName BROWSE WAITbrowse
  14
  15         global SearchType
  16         set SearchType $searchtype
  17
  18     set base .getfilename
  19     if {[winfo exists .getfilename]} {
  20         wm deiconify .getfilename; return
  21     }
  22     ###################
  23     # CREATING WIDGETS
  24     ###################
  25     toplevel .getfilename -class Toplevel \
  26         -background #ffffff
  27     wm focusmodel .getfilename passive
  28     wm maxsize .getfilename 1265 994
  29     wm minsize .getfilename 1 1
  30     wm overrideredirect .getfilename 0
  31     wm resizable .getfilename 1 1
  32     wm deiconify .getfilename
  33      wm geometry .getfilename +100+100
  34     wm title .getfilename $MSG_title
  35     #wm iconbitmap .getfilename @$TKW/shared/images/setup2.xbm
  36     #wm iconmask   .getfilename @$TKW/shared/images/setupmask2.xbm
  37
  38 #creates the message widget:
  39     message .getfilename.msg -justify center -text $message \
  40         -background #dddddd -aspect 300
  41
  42 # Creates the entry box:
  43         global GetFileName
  44         entry .getfilename.ent -textvar GetFileName -relief sunken -width 50
  45
  46     button .getfilename.but1 \
  47         -background #dddddd \
  48         -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* -padx 9 \
  49         -pady 3 -text $opt1 -width 8 -state disabled \
  50         -command {
  51                 destroy .getfilename
  52                 set WAITfilename opt1
  53                 return
  54         }
  55     button .getfilename.but2 \
  56         -background #dddddd \
  57         -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* -padx 9 \
  58         -pady 3 -text $opt2  -width 8\
  59         -command {destroy .getfilename; set WAITfilename opt2; return}
  60     button .getfilename.but3 \
  61         -background #dddddd \
  62         -font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* -padx 9 \
  63         -pady 3 -text $BROWSE  -width 8\
  64         -command {TkW:dirbrowse * * $SearchType
  65                 set WAITbrowse 1
  66                  while {$WAITbrowse == 1} {update}
  67                 if {$WAITbrowse == 0}   {
  68                    if {$SearchType == "File"} {
  69                          set GetFileName $SelectFile
  70                    } else {
  71                          set GetFileName $SelectFolder
  72                    }
  73                 }
  74               update
  75         }
  76     ###################
  77     ###################
  78     # SETTING GEOMETRY
  79     ###################
  80 #set H2 [expr $H +10]
  81     pack .getfilename.msg -padx 5 -pady 5
  82          #-anchor nw -bordermode ignore
  83     pack .getfilename.ent -padx 5 -pady 5
  84     pack .getfilename.but1 -padx 30 -pady 10 -side left
  85     pack .getfilename.but3 -padx 0 -pady 10 -side left
  86     pack .getfilename.but2 -padx 30 -pady 10 -side left
  87         #-x 110 -y $H2 -width 100 -height 28 -anchor nw -bordermode ignore
  88
  89         #bind .getfilename.ent <KeyPress-Return> {.getfilename.but1 invoke}
  90
  91     while {[winfo exists .getfilename]} {
  92         if {[file exists $GetFileName]} {
  93                 .getfilename.but1 configure -state normal
  94         } else {
  95                 .getfilename.but1 configure -state disabled
  96         }
  97         update
  98     }
  99 }