home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / open.ui.tcl < prev    next >
Encoding:
Text File  |  1995-11-06  |  2.8 KB  |  118 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # interface generated from open.ui
  8. #   root     is the parent window for this user interface
  9.  
  10. proc open_ui {root args} {
  11.  
  12.     # this treats "." as a special case
  13.  
  14.     if {$root == "."} {
  15.         set base ""
  16.     } else {
  17.         set base $root
  18.     }
  19.     
  20.     frame $base.frame#1
  21.  
  22.     label $base.label#1 \
  23.         -text {Open Project}
  24.     catch {
  25.         $base.label#1 configure \
  26.             -font -*-Helvetica-Bold-R-Normal--*-160-*-*-*-*-*-*
  27.     }
  28.  
  29.     entry $base.entry \
  30.         -textvariable entry
  31.  
  32.     listbox $base.listbox \
  33.         -height 0 \
  34.         -width 0 \
  35.         -yscrollcommand "$base.scrollbar#1 set"
  36.  
  37.     scrollbar $base.scrollbar#1 \
  38.         -command "$base.listbox yview" \
  39.         -orient v
  40.  
  41.     button $base.ok \
  42.         -command "load_project  \[$base.entry get\].\$P(file_suffix); destroy $root" \
  43.         -padx 11 \
  44.         -pady 4 \
  45.         -text OK
  46.  
  47.     button $base.button#2 \
  48.         -command "destroy $root" \
  49.         -padx 11 \
  50.         -pady 4 \
  51.         -text Cancel
  52.  
  53.  
  54.     # Geometry management
  55.  
  56.     blt_table $root $base.frame#1     3,3 
  57.     blt_table $root $base.label#1     1,1  \
  58.         -columnspan 3
  59.     blt_table $root $base.entry     2,1  \
  60.         -fill x
  61.     blt_table $root $base.listbox     3,1  \
  62.         -fill both
  63.     blt_table $root $base.scrollbar#1     3,2  \
  64.         -fill y
  65.     blt_table $base.frame#1 $base.ok     1,1  \
  66.         -fill both
  67.     blt_table $base.frame#1 $base.button#2     3,1  \
  68.         -fill both
  69.  
  70.     # Resize behavior management
  71.  
  72.     blt_table row $root configure all -resize none
  73.     blt_table row $root configure 3 -resize both
  74.     blt_table row $root configure 1 -height {30 Inf}
  75.     blt_table row $root configure 2 -height {30 Inf}
  76.     blt_table row $root configure 3 -height {148 Inf}
  77.     blt_table column $root configure all -resize none
  78.     blt_table column $root configure 1 -resize both
  79.     blt_table column $root configure 1 -width {136 Inf}
  80.     blt_table column $root configure 2 -width {30 Inf}
  81.     blt_table column $root configure 3 -width {30 Inf}
  82.  
  83.     blt_table row $base.frame#1 configure all -resize none
  84.     blt_table row $base.frame#1 configure 1 -height {30 Inf}
  85.     blt_table row $base.frame#1 configure 2 -height {30 Inf}
  86.     blt_table row $base.frame#1 configure 3 -height {30 Inf}
  87.     blt_table column $base.frame#1 configure all -resize none
  88.     blt_table column $base.frame#1 configure 1 -width {30 Inf}
  89. # additional interface code
  90. bind $base.entry <Return> "$base.ok invoke"
  91. bind $base.listbox <1> {
  92.     [winfo parent %W].entry delete 0 end
  93.     [winfo parent %W].entry insert 0 [%W get [%W nearest %y]]
  94. }
  95.  
  96. bind $base.listbox <Return> {
  97.     [winfo parent %W].entry delete 0 end
  98.     [winfo parent %W].entry insert 0 [%W get [%W curselection]]
  99.     [winfo parent %W].ok invoke
  100. }
  101.  
  102. bind $base.listbox <Double-1> "$base.ok invoke; break"
  103.  
  104. # fill the list box
  105.  
  106. set files ""
  107. regsub -all {\.ui } "[glob -nocomplain *.ui] " { } files
  108. eval $base.listbox insert 0 [lsort $files]
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115. # end additional interface code
  116.  
  117. }
  118.