/[gnats]/gnats/contrib/tkgnats/tkpr_library.tcl
ViewVC logotype

Diff of /gnats/contrib/tkgnats/tkpr_library.tcl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by mcr, Mon Dec 3 17:45:50 2001 UTC revision 1.5 by mcr, Thu Dec 19 04:19:38 2002 UTC
# Line 1210  proc radiobar_frame {parent frname} { Line 1210  proc radiobar_frame {parent frname} {
1210      frame $frname.labels      frame $frname.labels
1211      frame $frname.values      frame $frname.values
1212      frame $frname.bars      frame $frname.bars
1213      pack  $frname.labels -side left -anchor w -padx 2 -pady 0 -fill y -expand 1      grid  columnconfigure $frname 0 -weight 0
1214      pack  $frname.values -side left -anchor w -padx 0 -pady 0 -fill y -expand 1      grid  columnconfigure $frname 1 -weight 0
1215      pack  $frname.bars   -side left -anchor w -padx 0 -pady 0 -fill y -expand 1      grid  columnconfigure $frname 2 -weight 1
     pack  $frname -anchor w -pady 0  
1216  }  }
1217    
1218  # text field related procs  # text field related procs
# Line 1450  proc set_text_traversal {tlist} { Line 1449  proc set_text_traversal {tlist} {
1449      }      }
1450  }  }
1451    
1452  proc bagged_radiobar {fr n labeltext blist offLabel dstbag {valwid 0}} {  proc bagged_radiobar {fr n labeltext blist offLabel dstbag {valwid 0} {rownum 0}} {
1453      radiobar $fr $n $labeltext $blist $offLabel > $dstbag $valwid      radiobar $fr $n $labeltext $blist $offLabel > $dstbag $valwid $rownum
1454  }  }
1455    
1456  # make one in a list a radiobutton bar  # make one in a list a radiobutton bar
1457  proc radiobar {fr n labeltext blist offLabel {varprefix ""} {aname ""} {valwid 0}} {  proc radiobar {fr n labeltext blist offLabel {varprefix ""} {aname ""} {valwid 0} {rownum 0}} {
1458      global TkGnats flds tcl_platform      global TkGnats flds tcl_platform
1459      if {$tcl_platform(platform) == "unix"} {      if {$tcl_platform(platform) == "unix"} {
1460          set buttonbd 2          set buttonbd 2
# Line 1469  proc radiobar {fr n labeltext blist offL Line 1468  proc radiobar {fr n labeltext blist offL
1468      }      }
1469      global $vname      global $vname
1470    
1471        # alternate the colours so one can see the seperations
1472        if {($rownum & 1) == 1} {
1473            set panelbg "lightblue"
1474        } {
1475            set panelbg "grey"
1476        }
1477    
1478      set alias [get_field_alias $labeltext]      set alias [get_field_alias $labeltext]
1479      set $vname ""      set $vname ""
1480      button $fr.labels.$n -text "${alias}: " -command "helpMsg $alias" \      button $fr.labels_$n -text "${alias}: " -command "helpMsg $alias" \
1481              -relief flat -padx 0 -pady 0 -borderwidth 0 -width 14 -anchor w \              -relief flat -padx 0 -pady 0 -borderwidth 0 -width 14 -anchor w \
1482              -highlightthickness 0 -borderwidth 0              -highlightthickness 0 -borderwidth 0
1483      pack   $fr.labels.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0  
1484        grid   $fr.labels_$n -in $fr -column 0 -row $rownum -sticky w -padx 0 -pady 0 -ipady 0
1485            
1486      if {$valwid != 0} {      if {$valwid != 0} {
1487          label $fr.values.$n -text "[string trim $flds($varprefix$labeltext) " \n\t"]" \          label $fr.values_$n -text "[string trim $flds($varprefix$labeltext) " \n\t"]" \
1488                  -relief groove -anchor w -width $valwid -background $TkGnats(ReadOnlyBackground) \                  -relief groove -anchor w -width $valwid -background $TkGnats(ReadOnlyBackground) \
1489                  -padx 2 -pady 0 -highlightthickness 0 -borderwidth 2                  -padx 2 -pady 0 -highlightthickness 0 -borderwidth 2
1490          pack  $fr.values.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0          grid  $fr.values_$n -in $fr -column 1 -row $rownum -sticky {w n s} -padx 0 -pady 0 -ipady 0
1491      }      }
1492    
1493      if {[check_suppressed_field $labeltext] == 2} {      if {[check_suppressed_field $labeltext] == 2} {
# Line 1488  proc radiobar {fr n labeltext blist offL Line 1495  proc radiobar {fr n labeltext blist offL
1495      } {      } {
1496          set state normal          set state normal
1497      }      }
1498      frame $fr.bars.$n      frame $fr.bars_$n -bg $panelbg
1499        set bcount 0
1500        set bframe 0
1501        frame $fr.bars_$n.$bframe -bg $panelbg
1502        pack $fr.bars_$n.$bframe -side top -anchor nw -fill x
1503    
1504      foreach b $blist {      foreach b $blist {
1505          radiobutton $fr.bars.$n._$b \          radiobutton $fr.bars_$n._$b -bg $panelbg \
1506                  -text $b -relief flat -variable $vname -pady 0 \                  -text $b -relief flat -variable $vname -pady 0 \
1507                  -highlightthickness 0 -borderwidth $buttonbd -state $state                  -highlightthickness 0 -borderwidth $buttonbd -state $state
1508          # Buttons that say None should set variable to the empty          # Buttons that say None should set variable to the empty
1509          # string...          # string...
1510          if {"$b" == "$offLabel"} {          if {"$b" == "$offLabel"} {
1511              $fr.bars.$n._$b configure -value ""              $fr.bars_$n._$b configure -value ""
1512          } {          } {
1513              $fr.bars.$n._$b configure -value $b              $fr.bars_$n._$b configure -value $b
1514          }          }
1515          pack $fr.bars.$n._$b -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0          pack $fr.bars_$n._$b -in $fr.bars_$n.$bframe -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0
1516            incr bcount
1517            if {$bcount > 7} {
1518                set bcount 0
1519                incr bframe
1520                frame $fr.bars_$n.$bframe -bg $panelbg
1521                pack $fr.bars_$n.$bframe -side top -anchor nw -fill x
1522            }
1523      }      }
1524      pack $fr.bars.$n -side top -anchor w -expand true -fill x -padx 0 -pady 0      grid $fr.bars_$n -in $fr -column 3 -row $rownum -sticky {w e} -padx 0 -pady 0
1525  }  }
1526    
1527  proc radiobar_set {fr n b} {  proc radiobar_set {fr n b} {
1528      $fr.bars.$n._$b invoke      $fr.bars_$n._$b invoke
1529  }  }
1530    
1531  # make one in a list a radiobutton bar  # make one in a list a radiobutton bar
1532  proc checkbar {fr n labeltext blist offLabel} {  proc checkbar {fr n labeltext blist offLabel {rownum 0}} {
1533      global tcl_platform      global tcl_platform
1534      if {$tcl_platform(platform) == "unix"} {      if {$tcl_platform(platform) == "unix"} {
1535          set buttonbd 2          set buttonbd 2
# Line 1519  proc checkbar {fr n labeltext blist offL Line 1538  proc checkbar {fr n labeltext blist offL
1538      }      }
1539      upvar #0 gbag ${labeltext}      upvar #0 gbag ${labeltext}
1540    
1541        # alternate the colours so one can see the seperations
1542        if {($rownum & 1) == 1} {
1543            set panelbg "lightblue"
1544        } {
1545            set panelbg "grey"
1546        }
1547    
1548      set alias [get_field_alias $labeltext]      set alias [get_field_alias $labeltext]
1549      button $fr.labels.$n -text "${alias}: " -command "helpMsg $alias" \      button $fr.labels_$n -text "${alias}: " -command "helpMsg $alias" \
1550              -relief flat -width 14 -padx 0 -pady 0 -borderwidth 0 -anchor w -highlightthickness 0              -relief flat -width 14 -padx 0 -pady 0 -borderwidth 0 -anchor w -highlightthickness 0
1551      pack   $fr.labels.$n -side top -anchor w -padx 0 -pady 0 -fill none -expand 1 -ipady 0  
1552      frame  $fr.bars.$n      grid   $fr.labels_$n -in $fr -column 0 -row $rownum -sticky w -padx 0 -pady 0 -ipady 0
1553    
1554        frame $fr.bars_$n -bg $panelbg
1555        set bcount 0
1556        set bframe 0
1557        frame $fr.bars_$n.$bframe -bg $panelbg
1558        pack $fr.bars_$n.$bframe -side top -anchor nw -fill x
1559    
1560      foreach b $blist {      foreach b $blist {
1561          checkbutton $fr.bars.$n._$b \          checkbutton $fr.bars_$n._$b -bg $panelbg \
1562                  -offvalue "" \                  -offvalue "" \
1563                  -text $b -relief flat -highlightthickness 0 -borderwidth $buttonbd \                  -text $b -relief flat -highlightthickness 0 -borderwidth $buttonbd \
1564                  -variable [format "%s(%s)" ${labeltext} ${b}] -pady 0                  -variable [format "%s(%s)" ${labeltext} ${b}] -pady 0
1565    
1566          # Buttons that say None should set variable to the empty string...          # Buttons that say None should set variable to the empty string...
1567          if {"$b" == "$offLabel"} {          if {"$b" == "$offLabel"} {
1568              $fr.bars.$n._$b configure -onvalue "_ALL_" -offvalue ""              $fr.bars_$n._$b configure -onvalue "_ALL_" -offvalue ""
1569          } {          } {
1570              $fr.bars.$n._$b configure -onvalue $b -offvalue ""              $fr.bars_$n._$b configure -onvalue $b -offvalue ""
1571          }          }
1572          set gbag($b) ""          set gbag($b) ""
1573          pack $fr.bars.$n._$b -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0          pack $fr.bars_$n._$b -in $fr.bars_$n.$bframe -side left -anchor w -padx 8 -pady 0 -fill none -expand 0 -ipady 0
1574    
1575            incr bcount
1576            if {$bcount > 7} {
1577                set bcount 0
1578                incr bframe
1579                frame $fr.bars_$n.$bframe -bg $panelbg
1580                pack $fr.bars_$n.$bframe -side top -anchor nw -fill x
1581            }
1582      }      }
1583      # set active [lindex $blist 0]      # set active [lindex $blist 0]
1584      # $fr.bars.$n.$active select      # $fr.bars_$n.$active select
1585      pack $fr.bars.$n -side top -anchor w -expand true -fill x -padx 0 -pady 0  
1586        grid $fr.bars_$n -in $fr -column 3 -row $rownum -sticky {w e} -padx 0 -pady 0
1587  }  }
1588    
1589  #  #

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26