Tk Library Source Code

Artifact [616d7a2c09]
Login

Artifact 616d7a2c099c5b7c1036249f24c6b64264d59b80:

Attachment "changes.txt" to ticket [586720ffff] added by ashalagi 2002-07-26 04:20:13. Also attachment "changes.txt" to ticket [586708ffff] added by nobody 2002-07-26 03:57:40.
Common subdirectories: ./CVS and ../mclistbox_submit/CVS
Only in .: changes.txt
diff -c ./example.tcl ../mclistbox_submit/example.tcl
*** ./example.tcl	Tue Aug  3 16:24:22 1999
--- ../mclistbox_submit/example.tcl	Wed Jul 24 12:03:21 2002
***************
*** 28,50 ****
      # we will purposefully make the width less than the sum of the
      # columns so that the scrollbars will be functional right off
      # the bat.
      mclistbox .listbox \
  	    -bd 0 \
  	    -height 10 \
  	    -width 60 \
  	    -columnrelief flat \
  	    -labelanchor w \
  	    -columnborderwidth 0 \
  	    -selectcommand "showSelection" \
! 	    -selectmode extended \
  	    -labelborderwidth 2 \
  	    -fillcolumn name \
  	    -xscrollcommand [list .hsb set] \
! 	    -yscrollcommand [list .vsb set]
  
      # add the columns we want to see
      .listbox column add name -label "Name"          -width 40
!     .listbox column add size -label "Size"          -width 12
      .listbox column add mod  -label "Last Modified" -width 18
  
      # set up bindings to sort the columns.
--- 28,54 ----
      # we will purposefully make the width less than the sum of the
      # columns so that the scrollbars will be functional right off
      # the bat.
+     set sample_font [font create Fixed -family Courier -size 10 -weight normal -slant roman]  
      mclistbox .listbox \
  	    -bd 0 \
  	    -height 10 \
+ 	    -font $sample_font \
  	    -width 60 \
  	    -columnrelief flat \
  	    -labelanchor w \
+ 	    -selectcolumn 1 \
  	    -columnborderwidth 0 \
  	    -selectcommand "showSelection" \
! 	    -selectmode single \
  	    -labelborderwidth 2 \
  	    -fillcolumn name \
  	    -xscrollcommand [list .hsb set] \
! 	    -yscrollcommand [list .vsb set] \
! 	    -usecolumnxscroll 1
  
      # add the columns we want to see
      .listbox column add name -label "Name"          -width 40
!     .listbox column add size -label "Size"          -width 12 
      .listbox column add mod  -label "Last Modified" -width 18
  
      # set up bindings to sort the columns.
diff -c ./mclistbox.html ../mclistbox_submit/mclistbox.html
*** ./mclistbox.html	Tue May 30 19:46:13 2000
--- ../mclistbox_submit/mclistbox.html	Tue Jul 23 15:31:46 2002
***************
*** 235,240 ****
--- 235,251 ----
  A boolean value which determines whether column labels are shown or not.
  
  <P>
+ Command-Line Name: <STRONG>-selectcolumn</STRONG>  <EM>command</EM>  <br>
+ Database Name: <STRONG>selectColumn</STRONG><br>
+ Database Class: <STRONG>SelectColumn</STRONG>
+ 
+ 
+ <P>
+ Specifies behavior of selection. If -selectcolumn is set to 1 and -selectmode is set to single, 
+ then only one cell instead of hole line is highlighted upon click. Default value is 0. 
+ 
+ 
+ <P>
  Command-Line Name: <STRONG>-selectcommand</STRONG>  <EM>command</EM>  <br>
  Database Name: <STRONG>selectCommand</STRONG><br>
  Database Class: <STRONG>Command</STRONG>
***************
*** 269,274 ****
--- 280,300 ----
  of the option may be arbitrary, but the default bindings expect it to be
  either <STRONG>single</STRONG>, <STRONG>browse</STRONG>, <STRONG>multiple</STRONG>, or <STRONG>extended</STRONG>; the default value is browse.
  
+ 
+ <P>
+ Command-Line Name: <STRONG>-usecolumnxscroll</STRONG>  <br>
+ Database Name: <STRONG>usecolumnXscroll</STRONG><br>
+ Database Class: <STRONG>UseColumnXscroll</STRONG>
+ 
+ 
+ <P>
+ Specifies whether xscrollbars appear on bottom of columns. 
+ If set to 1, then xscrollbars are added to the bottom of each column. 
+ An xscrollbar of a column is visible if corresponding column option -usexscroll is set to 1 
+ (default value), otherwise it is invisible. Default is 0.
+ 
+ 
+ 
  <P>
  <H2><A NAME="DESCRIPTION">DESCRIPTION</A></H2>
  <P>
***************
*** 415,420 ****
--- 441,452 ----
  the desired width for the window is made just large enough to hold all the
  elements in the listbox.
  
+ <P><DT><STRONG><A NAME="item__usexscroll">-usexscroll</A></STRONG><DD>
+ <P>
+ Specifies whether corresponding xscrollbar is visible.
+ This option works only if -usecolumnxscroll is set to 1. If the value is 1,
+ it makes corresponding xscrollbar visible. Default value is 1.
+ 
  </DL>
  <P><DT><STRONG>pathName column delete name</STRONG><DD>
  <P>
***************
*** 454,464 ****
--- 486,506 ----
  to fill all of the columns, blank values will be used to fill in the
  missing columns.
  
+ <P><DT><STRONG>pathName  itemconfigure index column list ?list ...?</STRONG><DD>
+ <P>
+ Allows one to configure any given cell of a mclistbox. The arguments index and column specify a cell to be configures. 
+ <EM>list</EM> argument is a set of option-value pairs as in the listbox command itemconfigure.
+ 
  <P><DT><STRONG>pathName label bind name sequence command</STRONG><DD>
  <P>
  This command associates <EM>command</EM> with a column label such that whenever the event sequence given by <EM>sequence</EM> occurs over the label for the column named <EM>name</EM> the <EM>command</EM> will be invoked. This widget command is similar to the bind command except
  that it operates on column labels rather than the entire widget. See the
  bind manual entry for complete details on the syntax of <EM>sequence</EM> and the substitutions performed on <EM>command</EM> before invoking it. 
+ 
+ <P><DT><STRONG>::mclistbox::ResizeColumnsOfAllListboxes</STRONG><DD>
+ <P>
+ This command adjusts widths of columns according to set fonts of all mclistboxes in active an application. This function is supposed to be called after any font change. 
+ 
  
  </DL>
  <P>
diff -c ./mclistbox.tcl ../mclistbox_submit/mclistbox.tcl
*** ./mclistbox.tcl	Fri Sep  7 12:59:48 2001
--- ../mclistbox_submit/mclistbox.tcl	Thu Jul 25 15:33:16 2002
***************
*** 47,52 ****
--- 47,55 ----
      variable widgetCommands
      variable columnCommands
      variable labelCommands
+ 
+     # this is a list of existed listboxes
+     variable listboxesList
  }
  
  # ::mclistbox::Init --
***************
*** 111,116 ****
--- 114,120 ----
  	    -resizablecolumns    {resizableColumns    ResizableColumns} \
  	    -selectbackground    {selectBackground    Foreground} \
  	    -selectborderwidth   {selectBorderWidth   BorderWidth} \
+   	    -selectcolumn        {selectColumn        SelectColumn} \
  	    -selectcommand       {selectCommand       Command} \
  	    -selectforeground    {selectForeground    Background} \
  	    -selectmode          {selectMode          SelectMode} \
***************
*** 120,125 ****
--- 124,130 ----
  	    -width               {width               Width} \
  	    -xscrollcommand      {xScrollCommand      ScrollCommand} \
  	    -yscrollcommand      {yScrollCommand      ScrollCommand} \
+  	    -usecolumnxscroll    {usecolumnXscroll    UseColumnXscroll} \
  	    -iseditableindexcommand \
  	    {isEditableIndexCommand IsEditableIndexCommand} \
  	    ]
***************
*** 155,160 ****
--- 160,166 ----
  	    -editable           {editable             Editable} \
  	    -editcommand        {editcommand          Editcommand} \
  	    -listvar            {listvar              Listvar} \
+  	    -usexscroll         {usexscroll          UseXscroll} \
              ]
  
      # this defines the valid widget commands. It's important to
***************
*** 164,170 ****
  	    activate	 bbox       cget     column    configure  \
  	    curselection delete     edit     editcombo get       index      \
  	    insert 	 label      nearest  scan      see        \
! 	    selection  	 size       xview    yview
      ]
  
      set columnCommands [list add cget configure delete names nearest x]
--- 170,176 ----
  	    activate	 bbox       cget     column    configure  \
  	    curselection delete     edit     editcombo get       index      \
  	    insert 	 label      nearest  scan      see        \
! 	    selection  	 size       xview    yview     itemconfigure
      ]
  
      set columnCommands [list add cget configure delete names nearest x]
***************
*** 235,240 ****
--- 241,248 ----
  	option add *Mclistbox.fillcolumn          {}     widgetDefault
  	option add *Mclistbox.iseditableindexcommand   {} widgetDefault
          option add *Mclistbox.state               normal widgetDefault
+  	option add *Mclistbox.usecolumnXscroll    0      widgetDefault
+  	option add *Mclistbox.selectColumn        0      widgetDefault
  
  	# Bwidget stuff
  	option add *Mclistbox.dragEndCmd          {}     widgetDefault
***************
*** 260,265 ****
--- 268,274 ----
  		0   widgetDefault
  	option add *Mclistbox*MclistboxColumn.editcommand      \
  		""  widgetDefault
+  	option add *Mclistbox*MclistboxColumn.usexscroll    1   widgetDefault
      }
  
      ######################################################################
***************
*** 290,295 ****
--- 299,305 ----
  
  proc ::mclistbox::mclistbox {args} {
      variable widgetOptions
+     variable listboxesList
  
      # perform a one time initialization
      if {![info exists widgetOptions]} {
***************
*** 314,319 ****
--- 324,331 ----
      # build it...
      set w [eval Build $args]
  
+     # register the widget in the listboxes list
+     lappend listboxesList $w
      # set some bindings...
      SetBindings $w
  
***************
*** 748,753 ****
--- 760,770 ----
  	    -class MclistboxColumn \
  	    -background $options(-background) \
  	    ]
+     scrollbar $frame.xscroll -orient horizontal 
+     set misc(columnxscroll_args) [ list -elementborderwidth -relief -highlightbackground -highlightcolor -activebackground ]
+     foreach name $misc(columnxscroll_args) {
+         set misc(columnxscroll,$name) [ $frame.xscroll cget $name ]
+     }
  
      set label     \
  	    [label $frame.label \
***************
*** 819,831 ****
      # geometry propagation must be off so we can control the size
      # of the listbox by setting the size of the containing frame
      pack propagate $frame off
! 
      pack $label   -side top -fill x -expand n
      pack $listbox -side top -fill both -expand y -pady 2
  
      # any events that happen in the listbox gets handled by the class
      # bindings. This has the unfortunate side effect 
!     bindtags $listbox [list $w Mclistbox all]
      # Make the listbox a bwidget drag and drop site, if we have bwidgets
      if { $::mclistbox::bwidget } {
  	if { $options(-dragenabled) } {
--- 836,851 ----
      # geometry propagation must be off so we can control the size
      # of the listbox by setting the size of the containing frame
      pack propagate $frame off
!     if { $options(-usecolumnxscroll) } {
! 	pack $frame.xscroll -side bottom -fill x -expand 0 -anchor s
!     }
      pack $label   -side top -fill x -expand n
      pack $listbox -side top -fill both -expand y -pady 2
  
      # any events that happen in the listbox gets handled by the class
      # bindings. This has the unfortunate side effect 
!     bind $listbox <ButtonPress-1> [ list ::mclistbox::Set_Selected_Column %W $id ]
!     bindtags $listbox [list $listbox $w Mclistbox all]
      # Make the listbox a bwidget drag and drop site, if we have bwidgets
      if { $::mclistbox::bwidget } {
  	if { $options(-dragenabled) } {
***************
*** 847,852 ****
--- 867,883 ----
      return [list $frame $listbox $label $button]
  }
  
+ proc ::mclistbox::Set_Selected_Column { column_listbox column_id } {
+     
+     set w [ ::mclistbox::convert $column_listbox -W ]
+     
+     upvar ::mclistbox::${w}::misc misc
+     
+     set misc(selected_column_widget) $column_listbox
+     set misc(selected_column_id)     $column_id
+ }
+ 
+ 
  # ::mclistbox::Column-add --
  #
  #    Implements the "column add" widget command
***************
*** 895,900 ****
--- 926,932 ----
      set opts(-editable)    0
      set opts(-editcommand) ""
      set opts(-listvar)     ""
+     set opts(-usexscroll) 1
  
      if {[expr {[llength $args]%2}] == 1} {
  	# hmmm. An odd number of elements in args
***************
*** 1050,1055 ****
--- 1082,1088 ----
  	    }
  
  	    -width {
+ 		set widgets(width$id) $value
  		set font [$listbox cget -font]
  		set factor [font measure $options(-font) "0"]
  		set width [expr {$value * $factor}]
***************
*** 1163,1168 ****
--- 1196,1227 ----
                  # Set the list variable for the column
                  $listbox configure $option $value
  	    }
+ 
+             -usexscroll {
+                 if { $options(-usecolumnxscroll) } {
+                     set xscrollbar [ winfo parent $listbox ].xscroll
+                     if [ winfo exists $xscrollbar ] {
+                         if { $value } {
+                             $listbox configure -xscrollcommand [ list $xscrollbar set ]
+                             set cfg_args "-command \"$listbox xview\""
+                             foreach name $misc(columnxscroll_args) {
+                                 append cfg_args " $name \"$misc(columnxscroll,$name)\""
+                             }
+                             eval $xscrollbar configure $cfg_args
+                         } else {
+                             set xscrol_color [ $xscrollbar cget -background ]
+                             $listbox configure -xscrollcommand ""
+                             $xscrollbar configure \
+                                     -elementborderwidth 0 \
+                                     -relief groove \
+                                     -highlightbackground $xscrol_color \
+                                     -highlightcolor $xscrol_color \
+                                     -activebackground $xscrol_color \
+                                     -command ""
+                         }
+                     }
+                 }
+             }
  	}
      }
  }
***************
*** 1183,1188 ****
--- 1242,1249 ----
  
  proc ::mclistbox::DestroyHandler {w} {
  
+     variable listboxesList
+ 
      # kill off any idle event we might have pending
      if {[info exists ::mclistbox::${w}::misc(afterid)]} {
  	catch {
***************
*** 1197,1202 ****
--- 1258,1267 ----
      # brings tears to my eyes.
      if {[string compare [winfo class $w] "Mclistbox"] == 0} {
  	namespace delete ::mclistbox::$w
+  	set idx [lsearch -exact $listboxesList $w] 
+  	if { $idx != -1 } {
+  	    set listboxesList [lreplace $listboxesList $idx $idx]
+  	}
  	rename $w {}
      }
  
***************
*** 1466,1471 ****
--- 1531,1537 ----
  		unset widgets(listbox$id)
  		unset widgets(label$id)
  		unset widgets(editbutton$id)
+  		unset widgets(width$id)
  	    }
  	    InvalidateScrollbars $w
  	    set result ""
***************
*** 1535,1540 ****
--- 1601,1611 ----
  	    set result [$widgets(listbox$id) curselection]
  	}
  
+ 	itemconfigure {
+ 	    set result [eval ::mclistbox::Itemconfigure {$w} $args]
+ 	}
+ 
+ 
  	delete {
  	    if {[llength $args] < 1 || [llength $args] > 2} {
  		error "wrong \# of args: should be $w delete first ?last?"
***************
*** 1764,1769 ****
--- 1835,1843 ----
  		    }
  		    if {$index1 != ""} {
  			foreach id $misc(columns) {
+                             if { $options(-selectcolumn)  &&  \
+                                     [ info exists misc(selected_column_id) ]  &&  \
+                                     $id != $misc(selected_column_id) } continue
  			    eval {$widgets(listbox$id)} selection set \
  				    $index1 $index2
  			}
***************
*** 2222,2227 ****
--- 2296,2304 ----
  	set opts($name) $value
      }
  
+     # If we want to select inside separate column we must use "single" selectmode
+     if { [ info exists opts(-selectmode) ] && $opts(-selectmode) != "single" } { set opts(-selectcolumn) 0 }
+ 
      # process all of the configuration options
      foreach option [array names opts] {
  
***************
*** 2379,2384 ****
--- 2456,2462 ----
  			$listboxoption]
  	    }
  
+             -selectcolumn -
  	    -resizablecolumns {
  		if {$newValue} {
  		    set options($option) 1
***************
*** 2386,2392 ****
  		    set options($option) 0
  		}
  	    }
! 	    
  	    -labelimage -
  	    -labelheight -
  	    -labelrelief -
--- 2464,2477 ----
  		    set options($option) 0
  		}
  	    }
!             -usecolumnxscroll {
! 		if {$newValue} {
! 		    set options($option) 1
! 		} else {
! 		    set options($option) 0
! 		}
!                 ::mclistbox::UpdateColumnXScrollbars $w 
!             }
  	    -labelimage -
  	    -labelheight -
  	    -labelrelief -
***************
*** 2453,2458 ****
--- 2538,2559 ----
      }
  }
  
+ proc ::mclistbox::UpdateColumnXScrollbars { w } {
+ 
+     upvar ::mclistbox::${w}::widgets   widgets
+     upvar ::mclistbox::${w}::options   options
+     upvar ::mclistbox::${w}::misc      misc
+ 
+     foreach id $misc(columns) {
+         set column_xscroller $widgets(frame$id).xscroll
+         if { $options(-usecolumnxscroll) } {
+             catch { pack $column_xscroller -side bottom -fill x }
+         } else {
+             catch { pack forget $column_xscroller }
+         }
+     }
+ }
+ 
  # ::mclistbox::UpdateScrollbars --
  #
  #    This proc does the work of actually update the scrollbars to
***************
*** 2942,2947 ****
--- 3043,3118 ----
  	    $widgets(label$id) configure -cursor $options(-cursor)
  
  	}
+     }
+ }
+ 
+ 
+ # ::mclistbox::Itemconfigure  --
+ #
+ #    This implements the "itemconfigure" widget command; it configures specified row of the listbox 
+ #
+ # Arguments:
+ #
+ #    w         widget pathname
+ #    index     a valid listbox index of a row to be configured 
+ #    column    a column name
+ #    args      pairs of parameter names parameter values. For example: 
+ # -foreground black -selectforeground white
+ #
+ # Results:
+ #
+ #    Configures one specified cell in the listbox
+ 
+ proc ::mclistbox::Itemconfigure {w index column args} {
+     upvar ::mclistbox::${w}::widgets widgets
+     upvar ::mclistbox::${w}::misc    misc
+     if {[lsearch -exact $misc(columns) $column] == -1} {
+ 	error "unknown column $column ; must be one of: $misc(columns) "
+     }
+     set result [eval {$widgets(listbox$column)} itemconfigure $index $args ]
+     return $result
+ }
+ 
+ 
+ # ::mclistbox::ResizeColumns  --
+ #
+ #    Adjusts  widths of columns of a specified mclistbox according to currently set font.  
+ #
+ #
+ # Arguments:    w    widget pathname    
+ #
+ # Results:
+ # Changes widths of columns of a specified mclistbox.
+ 
+ proc ::mclistbox::ResizeColumns { w } {
+     upvar ::mclistbox::${w}::widgets widgets
+     upvar ::mclistbox::${w}::options options
+     upvar ::mclistbox::${w}::misc    misc
+     foreach id $misc(columns) {
+ 	set width $widgets(width$id)
+ 	set frame   $widgets(frame$id)
+ 	set listbox $widgets(listbox$id)
+ 	set font [$w column cget $id -font]
+ 	set factor [font measure $options(-font) "0"]
+ 	set pixels [expr {$width * $factor}]
+ 	$widgets(frame$id) configure -width $pixels
+ 	set misc(min-$widgets(frame$id)) $pixels
+ 	AdjustColumns $w
+     }
+ }
+ 
+ # ::mclistbox::ResizeColumnsOfAllListboxes  --
+ #
+ #    Adjusts  widths of columns of all mclistboxes according to currently set font.  
+ #
+ # Results:
+ # Changes widths of columns of all mclistboxes currently registered in an application.
+ 
+ 
+ proc ::mclistbox::ResizeColumnsOfAllListboxes { } {
+     variable listboxesList
+     foreach w $listboxesList {
+ 	::mclistbox::ResizeColumns $w
      }
  }
  
Only in ../mclistbox_submit/: mclistbox.tcl.my
Only in ../mclistbox_submit/: mclistbox.tcl.orig
Only in ../mclistbox_submit/: mclistbox.tcl.rej
diff -c ./test.tcl ../mclistbox_submit/test.tcl
*** ./test.tcl	Tue Nov 23 21:17:01 1999
--- ../mclistbox_submit/test.tcl	Tue Jul 23 17:00:37 2002
***************
*** 16,22 ****
      set ::foo [::mclistbox::mclistbox .container.foo \
  	    -yscrollcommand [list .container.vsb set] \
  	    -xscrollcommand [list .container.hsb set] \
! 	    -selectmode extended \
  	    -borderwidth 0 \
  	    -width 60 \
  	    -height 20 ]
--- 16,22 ----
      set ::foo [::mclistbox::mclistbox .container.foo \
  	    -yscrollcommand [list .container.vsb set] \
  	    -xscrollcommand [list .container.hsb set] \
! 	    -selectmode single \
  	    -borderwidth 0 \
  	    -width 60 \
  	    -height 20 ]