listbox.tcl

一个用TCL/TK写的用于verilog的集成编辑环境.

#  Command ListBox::selection
# ------------------------------------------------------------------------------
proc ListBox::selection { path cmd args } {
    variable $path
    upvar 0  $path data

    switch -- $cmd {
        set {
            set data(selitems) {}
            foreach item $args {
                if { [lsearch $data(selitems) $item] == -1 } {
                    if { [lsearch $data(items) $item] != -1 } {
                        lappend data(selitems) $item
                    }
                }
            }
        }
        add {
            foreach item $args {
                if { [lsearch $data(selitems) $item] == -1 } {
                    if { [lsearch $data(items) $item] != -1 } {
                        lappend data(selitems) $item
                    }
                }
            }
        }
        remove {
            foreach item $args {
                if { [set idx [lsearch $data(selitems) $item]] != -1 } {
                    set data(selitems) [lreplace $data(selitems) $idx $idx]
                }
            }
        }
        clear {
            set data(selitems) {}
        }
        get {
            return $data(selitems)
        }
        default {
            return
        }
    }
    _redraw_idle $path 1
}


# ------------------------------------------------------------------------------
#  Command ListBox::exists
# ------------------------------------------------------------------------------
proc ListBox::exists { path item } {
    variable $path
    upvar 0  $path data

    return [expr {[lsearch $data(items) $item] != -1}]
}


# ------------------------------------------------------------------------------
#  Command ListBox::index
# ------------------------------------------------------------------------------
proc ListBox::index { path item } {
    variable $path
    upvar 0  $path data

    return [lsearch $data(items) $item]
}


# ------------------------------------------------------------------------------
#  Command ListBox::item - deprecated
# ------------------------------------------------------------------------------
proc ListBox::item { path first {last ""} } {
    variable $path
    upvar 0  $path data

    if { ![string length $last] } {
        return [lindex $data(items) $first]
    } else {
        return [lrange $data(items) $first $last]
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::items
# ------------------------------------------------------------------------------
proc ListBox::items { path {first ""} {last ""}} {
    variable $path
    upvar 0  $path data

    if { ![string length $first] } {
	return $data(items)
    }

    if { ![string length $last] } {
        return [lindex $data(items) $first]
    } else {
        return [lrange $data(items) $first $last]
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::see
# ------------------------------------------------------------------------------
proc ListBox::see { path item } {
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_listbox $path
    }
    set idn [$path:cmd find withtag n:$item]
    if { $idn != "" } {
        ListBox::_see $path $idn right
        ListBox::_see $path $idn left
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::edit
# ------------------------------------------------------------------------------
proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} {
    variable _edit
    variable $path
    upvar 0  $path data

    if { [Widget::getoption $path -redraw] && $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
        _redraw_listbox $path
    }
    set idn [$path:cmd find withtag n:$item]
    if { $idn != "" } {
        ListBox::_see $path $idn right
        ListBox::_see $path $idn left

        set oldfg  [$path:cmd itemcget $idn -fill]
        set sbg    [Widget::getoption $path -selectbackground]
        set coords [$path:cmd coords $idn]
        set x      [lindex $coords 0]
        set y      [lindex $coords 1]
        set bd     [expr {[$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness]}]
        set w      [expr {[winfo width $path] - 2*$bd}]
        set wmax   [expr {[$path:cmd canvasx $w]-$x}]

	$path:cmd itemconfigure $idn    -fill [Widget::getoption $path -background]
        $path:cmd itemconfigure s:$item -fill {} -outline {}

        set _edit(text) $text
        set _edit(wait) 0

        set frame  [frame $path.edit \
                        -relief flat -borderwidth 0 -highlightthickness 0 \
                        -background [Widget::getoption $path -background]]
        set ent    [entry $frame.edit \
                        -width              0     \
                        -relief             solid \
                        -borderwidth        1     \
                        -highlightthickness 0     \
                        -foreground         [Widget::getoption $path.$item -fill] \
                        -background         [Widget::getoption $path -background] \
                        -selectforeground   [Widget::getoption $path -selectforeground] \
                        -selectbackground   $sbg  \
                        -font               [Widget::getoption $path.$item -font] \
                        -textvariable       ListBox::_edit(text)]
        pack $ent -ipadx 8 -anchor w

        set idw [$path:cmd create window $x $y -window $frame -anchor w]
        trace variable ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
        tkwait visibility $ent
        grab  $frame
        BWidget::focus set $ent
        _update_edit_size $path $ent $idw $wmax
        update
        if { $select } {
            $ent selection range 0 end
            $ent icursor end
            $ent xview end
        }

        bind $ent <Escape> {set ListBox::_edit(wait) 0}
        bind $ent <Return> {set ListBox::_edit(wait) 1}
	if { $clickres == 0 || $clickres == 1 } {
	    bind $frame <Button>  "set ListBox::_edit(wait) $clickres"
	}

        set ok 0
        while { !$ok } {
            tkwait variable ListBox::_edit(wait)
            if { !$_edit(wait) || $verifycmd == "" ||
                 [uplevel \#0 $verifycmd [list $_edit(text)]] } {
                set ok 1
            }
        }
        trace vdelete ListBox::_edit(text) w "ListBox::_update_edit_size $path $ent $idw $wmax"
        grab release $frame
        BWidget::focus release $ent
        destroy $frame
        $path:cmd delete $idw
        $path:cmd itemconfigure $idn    -fill $oldfg
        $path:cmd itemconfigure s:$item -fill $sbg -outline $sbg

        if { $_edit(wait) } {
            return $_edit(text)
        }
    }
    return ""
}


# ------------------------------------------------------------------------------
#  Command ListBox::xview
# ------------------------------------------------------------------------------
proc ListBox::xview { path args } {
    return [eval $path:cmd xview $args]
}


# ------------------------------------------------------------------------------
#  Command ListBox::yview
# ------------------------------------------------------------------------------
proc ListBox::yview { path args } {
    return [eval $path:cmd yview $args]
}


# ------------------------------------------------------------------------------
#  Command ListBox::_update_edit_size
# ------------------------------------------------------------------------------
proc ListBox::_update_edit_size { path entry idw wmax args } {
    set entw [winfo reqwidth $entry]
    if { $entw >= $wmax } {
        $path:cmd itemconfigure $idw -width $wmax
    } else {
        $path:cmd itemconfigure $idw -width 0
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::_destroy
# ------------------------------------------------------------------------------
proc ListBox::_destroy { path } {
    variable $path
    upvar 0  $path data

    if { $data(upd,afterid) != "" } {
        after cancel $data(upd,afterid)
    }
    if { $data(dnd,afterid) != "" } {
        after cancel $data(dnd,afterid)
    }
    foreach item $data(items) {
        Widget::destroy $path.$item
    }

    Widget::destroy $path
    unset data
    rename $path {}
}


# ------------------------------------------------------------------------------
#  Command ListBox::_see
# ------------------------------------------------------------------------------
proc ListBox::_see { path idn side } {
    set bbox [$path:cmd bbox $idn]
    set scrl [$path:cmd cget -scrollregion]

    set ymax [lindex $scrl 3]
    set dy   [$path:cmd cget -yscrollincrement]
    set yv   [$path:cmd yview]
    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
    set yv1  [expr {round([lindex $yv 1]*$ymax/$dy)}]
    set y    [expr {int([lindex [$path:cmd coords $idn] 1]/$dy)}]
    if { $y < $yv0 } {
        $path:cmd yview scroll [expr {$y-$yv0}] units
    } elseif { $y >= $yv1 } {
        $path:cmd yview scroll [expr {$y-$yv1+1}] units
    }

    set xmax [lindex $scrl 2]
    set dx   [$path:cmd cget -xscrollincrement]
    set xv   [$path:cmd xview]
    if { ![string compare $side "right"] } {
        set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
        set x1  [expr {int([lindex $bbox 2]/$dx)}]
        if { $x1 >= $xv1 } {
            $path:cmd xview scroll [expr {$x1-$xv1+1}] units
        }
    } else {
        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
        set x0  [expr {int([lindex $bbox 0]/$dx)}]
        if { $x0 < $xv0 } {
            $path:cmd xview scroll [expr {$x0-$xv0}] units
        }
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::_update_scrollregion
# ------------------------------------------------------------------------------
proc ListBox::_update_scrollregion { path } {
    set bd   [expr {2*([$path:cmd cget -borderwidth]+[$path:cmd cget -highlightthickness])}]
    set w    [expr {[winfo width  $path] - $bd}]
    set h    [expr {[winfo height $path] - $bd}]
    set xinc [$path:cmd cget -xscrollincrement]
    set yinc [$path:cmd cget -yscrollincrement]
    set bbox [$path:cmd bbox all]
    if { [llength $bbox] } {
        set xs [lindex $bbox 2]
        set ys [lindex $bbox 3]

        if { $w < $xs } {
            set w [expr {int($xs)}]
            if { [set r [expr {$w % $xinc}]] } {
                set w [expr {$w+$xinc-$r}]
            }
        }
        if { $h < $ys } {
            set h [expr {int($ys)}]
            if { [set r [expr {$h % $yinc}]] } {
                set h [expr {$h+$yinc-$r}]
            }
        }
    }

    $path:cmd configure -scrollregion [list 0 0 $w $h]
}


# ------------------------------------------------------------------------------
#  Command ListBox::_draw_item
# ------------------------------------------------------------------------------
proc ListBox::_draw_item { path item x0 x1 y } {
    set indent [Widget::getoption $path.$item -indent]
    $path:cmd create text [expr {$x1+$indent}] $y \
        -text   [Widget::getoption $path.$item -text] \
        -fill   [Widget::getoption $path.$item -fill] \
        -font   [Widget::getoption $path.$item -font] \
        -anchor w \
        -tags   "item n:$item"
    if { [set win [Widget::getoption $path.$item -window]] != "" } {
        $path:cmd create window [expr {$x0+$indent}] $y \
            -window $win -anchor w -tags "win i:$item"
    } elseif { [set img [Widget::getoption $path.$item -image]] != "" } {
        $path:cmd create image [expr {$x0+$indent}] $y \
            -image $img -anchor w -tags "img i:$item"
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::_redraw_items
# ------------------------------------------------------------------------------
proc ListBox::_redraw_items { path } {
    variable $path
    upvar 0  $path data

    $path:cmd configure -cursor watch
    set dx   [Widget::getoption $path -deltax]
    set dy   [Widget::getoption $path -deltay]
    set padx [Widget::getoption $path -padx]
    set y0   [expr {$dy/2}]
    set x0   4
    set x1   [expr {$x0+$padx}]
    set nitem 0
    set drawn {}
    set data(xlist) {}
    if { [Widget::getoption $path -multicolumn] } {
        set nrows $data(nrows)
    } else {
        set nrows [llength $data(items)]
    }
    foreach item $data(upd,delete) {
        $path:cmd delete i:$item n:$item s:$item
    }
    foreach item $data(items) {
        if { [info exists data(upd,create,$item)] } {
            _draw_item $path $item $x0 $x1 $y0
            unset data(upd,create,$item)
        } else {
            set indent [Widget::getoption $path.$item -indent]
            $path:cmd coords n:$item [expr {$x1+$indent}] $y0
            $path:cmd coords i:$item [expr {$x0+$indent}] $y0
        }
        incr y0 $dy
        incr nitem
        lappend drawn n:$item
        if { $nitem == $nrows } {