Tk Library Source Code

Artifact [5ecb5eaafa]
Login

Artifact 5ecb5eaafa14b092c4a9cbf11b21ac6bd344e42b:

Attachment "lb_patch.txt" to ticket [458446ffff] added by bach 2001-09-04 23:56:26.

Motivation:

The BWidget ListBox insert command isn't a speed demon. This is not
too noticable for small lists, but it gets rather slow for big ones
E.g. inserting 500 entries with just -text and -image attributes set 
     takes approx. 1 second on a Pentium III 550MHz.

Problem analysis:

The bulk of the time in ListBox::insert gets eaten by a call to
Widget::init. In Widget::init, most of the time is used by
initializing and parsing from standard options database. The example
from above uses ~1250msec for building up the std. options and
~250msec to apply specific options for the item.

Proposed patch:

Two functions to speed up inserts of many items that are all almost
equal. 

First, Widget::copyinit. This works almost like the normal init, but
saves time by copying standard option initialization from a given
template. It then applies specific item options (just like init).

Second, ListBox::multipleinsert. This also works like its pendant
ListBox::insert, but knows about the aforementioned Widget::copyinit
function. I shortly thought of changing the original 'insert', but the
effects of a change there would not be backward compatible.

Sideeffects:
None to existing code. A widget function more to document for the user
(ListBox::multipleinsert).

Results:
The speedup of using multipleinsert is a factor of 2 when used almost
exactly like a multiple call to insert.
That is:

    set l
    foreach n {name1 name2 name3 ... namen} {
        lappend l $n "-text $n -image something.gif"
    }
    $list multipleinsert end $l

is 2 times faster than its pendant

    foreach n {name1 name2 name3 ... namen} {
        $list insert end $n -text $n -image something.gif
    }

Assuming that, e.g. all images used are the same (as in the example
above, the speedup is factor 3 by using:
    set l
    foreach n {name1 name2 name3 ... namen} {
        if {[llength $l] == 0} {
            lappend l $n "-text $n -image something.gif"
	} else {
            lappend l $n "-text $n"
        }
    $list multipleinsert end $l


Code:

In listbox.tcl:

# Bastien Chevreux ([email protected])
# The multipleinsert command performs inserts several items at once into
#  the list. It is faster than calling insert multiple times as it uses the
#  Widget::copyinit command for initializing all items after the 1st. The 
#  speedup factor is between 2 and 3 for typical usage, but could be higher
#  for inserts with many options.
#
# Syntax: path and index are as in the insert command
#         args is a list of even numbered elements where the 1st of each pair
#          corresponds to the item of 'insert' and the second to args of 'insert'.
# ------------------------------------------------------------------------------
#  Command ListBox::multipleinsert
# ------------------------------------------------------------------------------
proc ListBox::multipleinsert { path index args } {
    variable $path
    upvar 0  $path data

    # If we got only one list as arg, take the first element as args
    # This enables callers to use 
    #   $list multipleinsert index $thelist
    # instead of
    #   eval $list multipleinsert index $thelist

    if {[llength $args] == 1} {
	set args [lindex $args 0]
    }

    set count 0
    foreach {item iargs} $args {
	if { [lsearch $data(items) $item] != -1 } {
	    return -code error "item \"$item\" already exists"
	}
	
	if {$count==0} {
	    Widget::init ListBox::Item $path.$item $iargs
	    set firstpath $path.$item
	} else {
	    Widget::copyinit ListBox::Item $firstpath $path.$item $iargs
	}

	if { ![string compare $index "end"] } {
	    eval lappend data(items) $item
	} else {
	    set data(items) [linsert $data(items) $index $item]
	}
	set data(upd,create,$item) $item

	incr count
    }

    _redraw_idle $path 2
    return $item
}

       

In widget.tcl:

# Bastien Chevreux ([email protected])
#
# copyinit performs basically the same job as init, but it uses a
#  existing template to initialize its values. So, first a perferct copy
#  from the template is made just to be altered by any existing options
#  afterwards.
# But this still saves time as the first initialization parsing block is
#  skipped.
# As additional bonus, items that differ in just a few options can be
#  initialized faster by leaving out the options that are equal.

# This function is currently used only by ListBox::multipleinsert, but other
#  calls should follow :)

# ------------------------------------------------------------------------------
#  Command Widget::copyinit
# ------------------------------------------------------------------------------
proc Widget::copyinit { class templatepath path options } {
    upvar 0 ${class}::opt classopt
    upvar 0 ${class}::$path:opt  pathopt
    upvar 0 ${class}::$path:mod  pathmod
    upvar 0 ${class}::$path:init pathinit

    upvar 0 ${class}::$templatepath:opt   templatepathopt
    upvar 0 ${class}::$templatepath:mod   templatepathmod
    upvar 0 ${class}::$templatepath:init  templatepathinit

    if { [info exists pathopt] } {
	unset pathopt
    }
    if { [info exists pathmod] } {
	unset pathmod
    }

    # We use the template widget for option db copying, but it has to exist!
    array set pathmod  [array get templatepathmod]
    array set pathopt  [array get templatepathopt]
    array set pathinit [array get templatepathinit]

    set Widget::_class($path) $class
    foreach {option value} $options {
        if { ![info exists classopt($option)] } {
            unset pathopt
            unset pathmod
            return -code error "unknown option \"$option\""
        }
        set optdesc $classopt($option)
        set type    [lindex $optdesc 0]
        if { ![string compare $type "Synonym"] } {
            set option  [lindex $optdesc 1]
            set optdesc $classopt($option)
            set type    [lindex $optdesc 0]
        }
        set pathopt($option) [$Widget::_optiontype($type) $option $value [lindex $optdesc 3]]
	set pathinit($option) $pathopt($option)
    }
}