listbox.tcl

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

# ------------------------------------------------------------------------------
#  listbox.tcl
#  This file is part of Unifix BWidget Toolkit
#  $Id: listbox.tcl,v 1.11 1999/07/09 08:10:32 eric Exp $
# ------------------------------------------------------------------------------
#  Index of commands:
#     - ListBox::create
#     - ListBox::configure
#     - ListBox::cget
#     - ListBox::insert
#     - ListBox::itemconfigure
#     - ListBox::itemcget
#     - ListBox::bindText
#     - ListBox::bindImage
#     - ListBox::delete
#     - ListBox::move
#     - ListBox::reorder
#     - ListBox::selection
#     - ListBox::exists
#     - ListBox::index
#     - ListBox::item - deprecated
#     - ListBox::items
#     - ListBox::see
#     - ListBox::edit
#     - ListBox::xview
#     - ListBox::yview
#     - ListBox::_update_edit_size
#     - ListBox::_destroy
#     - ListBox::_see
#     - ListBox::_update_scrollregion
#     - ListBox::_draw_item
#     - ListBox::_redraw_items
#     - ListBox::_redraw_selection
#     - ListBox::_redraw_listbox
#     - ListBox::_redraw_idle
#     - ListBox::_resize
#     - ListBox::_init_drag_cmd
#     - ListBox::_drop_cmd
#     - ListBox::_over_cmd
#     - ListBox::_auto_scroll
#     - ListBox::_scroll
# ------------------------------------------------------------------------------


namespace eval ListBox {
    namespace eval Item {
        Widget::declare ListBox::Item {
            {-indent     Int        0       0 {=0}}
            {-text       String     ""      0}
            {-font       TkResource ""      0 listbox}
            {-image      TkResource ""      0 label}
            {-window     String     ""      0}
            {-fill       TkResource black   0 {listbox -foreground}}
            {-data       String     ""      0}
        }
    }

    Widget::tkinclude ListBox canvas :cmd \
        remove     {-insertwidth -insertbackground -insertborderwidth -insertofftime \
                        -insertontime -selectborderwidth -closeenough -confine -scrollregion \
                        -xscrollincrement -yscrollincrement -width -height} \
        initialize {-relief sunken -borderwidth 2 -takefocus 1 \
                        -highlightthickness 1 -width 200}

    Widget::declare ListBox {
        {-deltax           Int 10 0 {=0 ""}}
        {-deltay           Int 15 0 {=0 ""}}
        {-padx             Int 20 0 {=0 ""}}
        {-background       TkResource "" 0 listbox}
        {-selectbackground TkResource "" 0 listbox}
        {-selectforeground TkResource "" 0 listbox}
        {-width            TkResource "" 0 listbox}
        {-height           TkResource "" 0 listbox}
        {-redraw           Boolean 1  0}
        {-multicolumn      Boolean 0  0}
        {-dropovermode     Flag    "wpi" 0 "wpi"}
        {-bg               Synonym -background}
    }
    DragSite::include ListBox "LISTBOX_ITEM" 1
    DropSite::include ListBox {
        LISTBOX_ITEM {copy {} move {}}
    }

    Widget::addmap ListBox "" :cmd {-deltay -yscrollincrement}

    proc ::ListBox { path args } { return [eval ListBox::create $path $args] }
    proc use {} {}

    variable _edit
}


# ------------------------------------------------------------------------------
#  Command ListBox::create
# ------------------------------------------------------------------------------
proc ListBox::create { path args } {
    Widget::init ListBox $path $args

    variable $path
    upvar 0  $path data

    # widget informations
    set data(nrows) -1

    # items informations
    set data(items)    {}
    set data(selitems) {}

    # update informations
    set data(upd,level)   0
    set data(upd,afterid) ""
    set data(upd,level)   0
    set data(upd,delete)  {}

    # drag and drop informations
    set data(dnd,scroll)   ""
    set data(dnd,afterid)  ""
    set data(dnd,item)     ""

    eval canvas $path [Widget::subcget $path :cmd] \
        -width  [expr {[Widget::getoption $path -width]*8}] \
        -height [expr {[Widget::getoption $path -height]*[Widget::getoption $path -deltay]}] \
        -xscrollincrement 8

    bind $path <Configure> "ListBox::_resize  $path"
    bind $path <Destroy>   "ListBox::_destroy $path"

    DragSite::setdrag $path $path ListBox::_init_drag_cmd [Widget::getoption $path -dragendcmd] 1
    DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd 1

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval ListBox::\$cmd $path \$args\]"

    return $path
}


# ------------------------------------------------------------------------------
#  Command ListBox::configure
# ------------------------------------------------------------------------------
proc ListBox::configure { path args } {
    set res [Widget::configure $path $args]

    set ch1 [expr {[Widget::hasChanged $path -deltay dy]  |
                   [Widget::hasChanged $path -padx val]   |
                   [Widget::hasChanged $path -multicolumn val]}]

    set ch2 [expr {[Widget::hasChanged $path -selectbackground val] |
                   [Widget::hasChanged $path -selectforeground val]}]

    set redraw 0
    if { [Widget::hasChanged $path -height h] } {
        $path:cmd configure -height [expr {$h*$dy}]
        set redraw 1
    }
    if { [Widget::hasChanged $path -width w] } {
        $path:cmd configure -width [expr {$w*8}]
        set redraw 1
    }

    if { !$redraw } {
        if { $ch1 } {
            _redraw_idle $path 2
        } elseif { $ch2 } {
            _redraw_idle $path 1
        }
    }

    if { [Widget::hasChanged $path -redraw bool] && $bool } {
        variable $path
        upvar 0  $path data
        set lvl $data(upd,level)
        set data(upd,level) 0
        _redraw_idle $path $lvl
    }
    set force [Widget::hasChanged $path -dragendcmd dragend]
    DragSite::setdrag $path $path ListBox::_init_drag_cmd $dragend $force
    DropSite::setdrop $path $path ListBox::_over_cmd ListBox::_drop_cmd

    return $res
}


# ------------------------------------------------------------------------------
#  Command ListBox::cget
# ------------------------------------------------------------------------------
proc ListBox::cget { path option } {
    return [Widget::cget $path $option]
}


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

    if { [lsearch $data(items) $item] != -1 } {
        return -code error "item \"$item\" already exists"
    }

    Widget::init ListBox::Item $path.$item $args

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

    _redraw_idle $path 2
    return $item
}


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

    if { [lsearch $data(items) $item] == -1 } {
        return -code error "item \"$item\" does not exist"
    }

    set oldind [Widget::getoption $path.$item -indent]

    set res   [Widget::configure $path.$item $args]
    set chind [Widget::hasChanged $path.$item -indent indent]
    set chw   [Widget::hasChanged $path.$item -window win]
    set chi   [Widget::hasChanged $path.$item -image  img]
    set cht   [Widget::hasChanged $path.$item -text txt]
    set chf   [Widget::hasChanged $path.$item -font fnt]
    set chfg  [Widget::hasChanged $path.$item -fill fg]
    set idn   [$path:cmd find withtag n:$item]

    if { $idn == "" } {
        # item is not drawn yet
        _redraw_idle $path 2
        return $res
    }

    set oldb   [$path:cmd bbox $idn]
    set coords [$path:cmd coords $idn]
    set padx   [Widget::getoption $path -padx]
    set x0     [expr {[lindex $coords 0]-$padx-$oldind+$indent}]
    set y0     [lindex $coords 1]
    if { $chw || $chi } {
        # -window or -image modified
        set idi  [$path:cmd find withtag i:$item]
        set type [lindex [$path:cmd gettags $idi] 0]
        if { [string length $win] } {
            if { ![string compare $type "win"] } {
                $path:cmd itemconfigure $idi -window $win
            } else {
                $path:cmd delete $idi
                $path:cmd create window $x0 $y0 -window $win -anchor w -tags "win i:$item"
            }
        } elseif { [string length $img] } {
            if { ![string compare $type "img"] } {
                $path:cmd itemconfigure $idi -image $img
            } else {
                $path:cmd delete $idi
                $path:cmd create image $x0 $y0 -image $img -anchor w -tags "img i:$item"
            }
        } else {
            $path:cmd delete $idi
        }
    }

    if { $cht || $chf || $chfg } {
        # -text or -font modified, or -fill modified
        $path:cmd itemconfigure $idn -text $txt -font $fnt -fill $fg
        _redraw_idle $path 1
    }

    if { $chind } {
        # -indent modified
        $path:cmd coords $idn [expr {$x0+$padx}] $y0
        $path:cmd coords i:$item $x0 $y0
        _redraw_idle $path 1
    }

    if { [Widget::getoption $path -multicolumn] && ($cht || $chf || $chind) } {
        set bbox [$path:cmd bbox $idn]
        if { [lindex $bbox 2] > [lindex $oldb 2] } {
            _redraw_idle $path 2
        }
    }

    return $res
}


# ------------------------------------------------------------------------------
#  Command ListBox::itemcget
# ------------------------------------------------------------------------------
proc ListBox::itemcget { path item option } {
    return [Widget::cget $path.$item $option]
}


# ------------------------------------------------------------------------------
#  Command ListBox::bindText
# ------------------------------------------------------------------------------
proc ListBox::bindText { path event script } {
    if { $script != "" } {
        $path:cmd bind "item" $event \
            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
    } else {
        $path:cmd bind "item" $event {}
    }
}


# ------------------------------------------------------------------------------
#  Command ListBox::bindImage
# ------------------------------------------------------------------------------
proc ListBox::bindImage { path event script } {
    if { $script != "" } {
        $path:cmd bind "img" $event \
            "$script \[string range \[lindex \[$path:cmd gettags current\] 1\] 2 end\]"
    } else {
        $path:cmd bind "img" $event {}
    }
}


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

    foreach litems $args {
        foreach item $litems {
            set idx [lsearch $data(items) $item]
            if { $idx != -1 } {
                set data(items) [lreplace $data(items) $idx $idx]
                Widget::destroy $path.$item
                if { [info exists data(upd,create,$item)] } {
                    unset data(upd,create,$item)
                } else {
                    lappend data(upd,delete) $item
                }
            }
        }
    }

    set sel $data(selitems)
    set data(selitems) {}
    eval selection $path set $sel
    _redraw_idle $path 2
}


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

    if { [set idx [lsearch $data(items) $item]] == -1 } {
        return -code error "item \"$item\" does not exist"
    }

    set data(items) [lreplace $data(items) $idx $idx]
    if { ![string compare $index "end"] } {
        lappend data($path,item) $item
    } else {
        set data(items) [linsert $data(items) $index $item]
    }

    _redraw_idle $path 2
}


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

    set data(items) [BWidget::lreorder $data(items) $neworder]
    _redraw_idle $path 2
}


# ------------------------------------------------------------------------------