#============================================================================== # Contains public and private procedures used in tablelist bindings. # # Structure of the module: # - Public helper procedures # - Binding tag Tablelist # - Binding tag TablelistWindow # - Binding tag TablelistBody # - Binding tags TablelistLabel, TablelistSubLabel, and TablelistArrow # # Copyright (c) 2000-2010 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # # Public helper procedures # ======================== # #------------------------------------------------------------------------------ # tablelist::getTablelistColumn # # Gets the column number from the path name w of a (sub)label or sort arrow of # a tablelist widget. #------------------------------------------------------------------------------ proc tablelist::getTablelistColumn w { if {[regexp {^(\..+)\.hdr\.t\.f\.l([0-9]+)(-[it]l)?$} $w dummy win col] || [regexp {^(\..+)\.hdr\.t\.f\.c([0-9]+)$} $w dummy win col]} { return $col } else { return -1 } } #------------------------------------------------------------------------------ # tablelist::getTablelistPath # # Gets the path name of the tablelist widget from the path name w of one of its # descendants. It is assumed that all of the ancestors of w exist (but w # itself needn't exist). #------------------------------------------------------------------------------ proc tablelist::getTablelistPath w { return [mwutil::getAncestorByClass $w Tablelist] } #------------------------------------------------------------------------------ # tablelist::convEventFields # # Gets the path name of the tablelist widget and the x and y coordinates # relative to the latter from the path name w of one of its descendants and # from the x and y coordinates relative to the latter. #------------------------------------------------------------------------------ proc tablelist::convEventFields {w x y} { return [mwutil::convEventFields $w $x $y Tablelist] } # # Binding tag Tablelist # ===================== # #------------------------------------------------------------------------------ # tablelist::addActiveTag # # This procedure is invoked when the tablelist widget win gains the keyboard # focus. It moves the "active" tag to the line or cell that displays the # active item or element of the widget in its body text child. #------------------------------------------------------------------------------ proc tablelist::addActiveTag win { upvar ::tablelist::ns${win}::data data set data(ownsFocus) 1 # # Conditionally move the "active" tag to the line # or cell that displays the active item or element # if {![info exists data(dispId)]} { moveActiveTag $win } } #------------------------------------------------------------------------------ # tablelist::removeActiveTag # # This procedure is invoked when the tablelist widget win loses the keyboard # focus. It removes the "active" tag from the body text child of the widget. #------------------------------------------------------------------------------ proc tablelist::removeActiveTag win { upvar ::tablelist::ns${win}::data data set data(ownsFocus) 0 $data(body) tag remove active 1.0 end } #------------------------------------------------------------------------------ # tablelist::cleanup # # This procedure is invoked when the tablelist widget win is destroyed. It # executes some cleanup operations. #------------------------------------------------------------------------------ proc tablelist::cleanup win { # # Cancel the execution of all delayed updateKeyToRowMap, adjustSeps, # makeStripes, showLineNumbers, stretchColumns, updateColors, # updateScrlColOffset, updateHScrlbar, updateVScrlbar, updateView, # adjustElidedText, synchronize, displayItems, horizAutoScan, forceRedraw, # doCellConfig, redisplay, redisplayCol, and destroyWidgets commands # upvar ::tablelist::ns${win}::data data foreach id {mapId sepsId stripesId lineNumsId stretchId colorId offsetId \ hScrlbarId vScrlbarId viewId elidedId syncId dispId afterId redrawId reconfigId} { if {[info exists data($id)]} { after cancel $data($id) } } foreach name [array names data *redispId] { after cancel $data($name) } foreach destroyId $data(destroyIdList) { after cancel $destroyId } # # If there is a list variable associated with the # widget then remove the trace set on this variable # upvar #0 $data(-listvariable) var if {$data(hasListVar) && [info exists var]} { trace vdelete var wu $data(listVarTraceCmd) } # # Destroy any existing bindings for data(bodyTag), # data(labelTag), and data(editwinTag) # foreach event [bind $data(bodyTag)] { bind $data(bodyTag) $event "" } foreach event [bind $data(labelTag)] { bind $data(labelTag) $event "" } foreach event [bind $data(editwinTag)] { bind $data(editwinTag) $event "" } namespace delete ::tablelist::ns$win catch {rename ::$win ""} } #------------------------------------------------------------------------------ # tablelist::updateCanvases # # This procedure handles the events and by configuring # the canvases displaying sort arrows. #------------------------------------------------------------------------------ proc tablelist::updateCanvases win { upvar ::tablelist::ns${win}::data data foreach col $data(arrowColList) { configCanvas $win $col raiseArrow $win $col } } #------------------------------------------------------------------------------ # tablelist::updateConfigSpecs # # This procedure handles the virtual event <> by updating the # theme-specific default values of some tablelist configuration options. #------------------------------------------------------------------------------ proc tablelist::updateConfigSpecs win { # # This might be an "after idle" callback; check whether the window exists # if {![winfo exists $win]} { return "" } set currentTheme [getCurrentTheme] upvar ::tablelist::ns${win}::data data if {[string compare $currentTheme $data(currentTheme)] == 0} { if {[string compare $currentTheme "tileqt"] == 0} { set widgetStyle [tileqt_currentThemeName] set colorScheme [getKdeConfigVal "KDE" "colorScheme"] if {[string compare $widgetStyle $data(widgetStyle)] == 0 && [string compare $colorScheme $data(colorScheme)] == 0} { return "" } } else { return "" } } # # Populate the array tmp with values corresponding to the old theme # and the array themeDefaults with values corresponding to the new one # array set tmp $data(themeDefaults) setThemeDefaults # # Set those configuration options whose values equal the old # theme-specific defaults to the new theme-specific ones # variable themeDefaults foreach opt {-background -foreground -disabledforeground -stripebackground -selectbackground -selectforeground -selectborderwidth -font -labelbackground -labelforeground -labelfont -labelborderwidth -labelpady -arrowcolor -arrowdisabledcolor -arrowstyle -treestyle} { if {[string compare $data($opt) $tmp($opt)] == 0} { doConfig $win $opt $themeDefaults($opt) } } foreach opt {-background -foreground} { doConfig $win $opt $data($opt) ;# sets the bg color of the separators } updateCanvases $win # # Destroy and recreate the edit window if present # if {[set editCol $data(editCol)] >= 0} { set editRow $data(editRow) saveEditData $win destroy $data(bodyFr) doEditCell $win $editRow $editCol 1 } # # Destroy and recreate the embedded windows # if {$data(winCount) != 0} { for {set row 0} {$row < $data(itemCount)} {incr row} { for {set col 0} {$col < $data(colCount)} {incr col} { set key [lindex $data(keyList) $row] if {[info exists data($key,$col-window)]} { set val $data($key,$col-window) doCellConfig $row $col $win -window "" doCellConfig $row $col $win -window $val } } } } set data(currentTheme) $currentTheme set data(themeDefaults) [array get themeDefaults] if {[string compare $currentTheme "tileqt"] == 0} { set data(widgetStyle) [tileqt_currentThemeName] set data(colorScheme) [getKdeConfigVal "KDE" "colorScheme"] } else { set data(widgetStyle) "" set data(colorScheme) "" } } # # Binding tag TablelistWindow # =========================== # #------------------------------------------------------------------------------ # tablelist::cleanupWindow # # This procedure is invoked when a window aux embedded into a tablelist widget # is destroyed. It invokes the cleanup script associated with the cell # containing the window, if any. #------------------------------------------------------------------------------ proc tablelist::cleanupWindow aux { regexp {^(.+)\.body\.frm_(k[0-9]+),([0-9]+)$} $aux dummy win key col upvar ::tablelist::ns${win}::data data if {[info exists data($key,$col-windowdestroy)]} { set row [keyToRow $win $key] uplevel #0 $data($key,$col-windowdestroy) [list $win $row $col $aux.w] } } # # Binding tag TablelistBody # ========================= # #------------------------------------------------------------------------------ # tablelist::defineTablelistBody # # Defines the bindings for the binding tag TablelistBody. #------------------------------------------------------------------------------ proc tablelist::defineTablelistBody {} { variable priv array set priv { x "" y "" afterId "" prevRow "" prevCol "" prevActExpCollCtrlCell "" selection {} clicked 0 clickTime 0 releaseTime 0 clickedInEditWin 0 clickedExpCollCtrl 0 } foreach event { } { bind TablelistBody $event [format { foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %%W %%x %%y] {} tablelist::showOrHideTooltip $tablelist::W \ $tablelist::x $tablelist::y %%X %%Y %s tablelist::updateExpCollCtrl %%W %%x %%y } $event] } bind TablelistBody { if {[winfo exists %W]} { foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %W %x %y] {} set tablelist::priv(x) $tablelist::x set tablelist::priv(y) $tablelist::y set tablelist::priv(row) [$tablelist::W nearest $tablelist::y] set tablelist::priv(col) [$tablelist::W nearestcolumn $tablelist::x] set tablelist::priv(clicked) 1 set tablelist::priv(clickTime) %t set tablelist::priv(clickedInEditWin) 0 if {[$tablelist::W cget -setfocus] && [string compare [$tablelist::W cget -state] "normal"] == 0} { focus [$tablelist::W bodypath] } if {[tablelist::wasExpCollCtrlClicked %W %x %y]} { set tablelist::priv(clickedExpCollCtrl) 1 } else { tablelist::condEditContainingCell $tablelist::W \ $tablelist::x $tablelist::y tablelist::condBeginMove $tablelist::W $tablelist::priv(row) tablelist::beginSelect $tablelist::W \ $tablelist::priv(row) $tablelist::priv(col) } } } bind TablelistBody { if {[$tablelist::W cget -editselectedonly]} { tablelist::condEditContainingCell $tablelist::W \ $tablelist::x $tablelist::y } } bind TablelistBody { if {$tablelist::priv(clicked) && %t - $tablelist::priv(clickTime) < 300} { continue } foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %W %x %y] {} if {[string compare $tablelist::priv(x) ""] == 0 || [string compare $tablelist::priv(y) ""] == 0} { set tablelist::priv(x) $tablelist::x set tablelist::priv(y) $tablelist::y } set tablelist::priv(prevX) $tablelist::priv(x) set tablelist::priv(prevY) $tablelist::priv(y) set tablelist::priv(x) $tablelist::x set tablelist::priv(y) $tablelist::y tablelist::condAutoScan $tablelist::W if {!$tablelist::priv(clickedExpCollCtrl)} { tablelist::motion $tablelist::W \ [$tablelist::W nearest $tablelist::y] \ [$tablelist::W nearestcolumn $tablelist::x] tablelist::condShowTarget $tablelist::W $tablelist::y } } bind TablelistBody { foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %W %x %y] {} set tablelist::priv(x) "" set tablelist::priv(y) "" after cancel $tablelist::priv(afterId) set tablelist::priv(afterId) "" set tablelist::priv(releaseTime) %t set tablelist::priv(releasedInEditWin) 0 if {!$tablelist::priv(clickedExpCollCtrl)} { if {$tablelist::priv(clicked) && %t - $tablelist::priv(clickTime) < 300} { tablelist::moveOrActivate $tablelist::W \ $tablelist::priv(row) $tablelist::priv(col) } else { tablelist::moveOrActivate $tablelist::W \ [$tablelist::W nearest $tablelist::y] \ [$tablelist::W nearestcolumn $tablelist::x] } } set tablelist::priv(clicked) 0 set tablelist::priv(clickedExpCollCtrl) 0 after 100 [list tablelist::condEvalInvokeCmd $tablelist::W] } bind TablelistBody { foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %W %x %y] {} tablelist::beginExtend $tablelist::W \ [$tablelist::W nearest $tablelist::y] \ [$tablelist::W nearestcolumn $tablelist::x] } bind TablelistBody { foreach {tablelist::W tablelist::x tablelist::y} \ [tablelist::convEventFields %W %x %y] {} tablelist::beginToggle $tablelist::W \ [$tablelist::W nearest $tablelist::y] \ [$tablelist::W nearestcolumn $tablelist::x] } bind TablelistBody { tablelist::condEditActiveCell [tablelist::getTablelistPath %W] } bind TablelistBody { tablelist::condEditActiveCell [tablelist::getTablelistPath %W] } bind TablelistBody { tablelist::nextPrevCell [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1 } bind TablelistBody <> { tablelist::nextPrevCell [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::plusMinus [tablelist::getTablelistPath %W] plus } bind TablelistBody { tablelist::plusMinus [tablelist::getTablelistPath %W] minus } bind TablelistBody { tablelist::plusMinus [tablelist::getTablelistPath %W] plus } bind TablelistBody { tablelist::plusMinus [tablelist::getTablelistPath %W] minus } bind TablelistBody { tablelist::upDown [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::upDown [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::leftRight [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::leftRight [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::priorNext [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::priorNext [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::homeEnd [tablelist::getTablelistPath %W] Home } bind TablelistBody { tablelist::homeEnd [tablelist::getTablelistPath %W] End } bind TablelistBody { tablelist::firstLast [tablelist::getTablelistPath %W] first } bind TablelistBody { tablelist::firstLast [tablelist::getTablelistPath %W] last } bind TablelistBody { tablelist::extendUpDown [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::extendUpDown [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::extendLeftRight [tablelist::getTablelistPath %W] -1 } bind TablelistBody { tablelist::extendLeftRight [tablelist::getTablelistPath %W] 1 } bind TablelistBody { tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] Home } bind TablelistBody { tablelist::extendToHomeEnd [tablelist::getTablelistPath %W] End } bind TablelistBody { tablelist::extendToFirstLast [tablelist::getTablelistPath %W] first } bind TablelistBody { tablelist::extendToFirstLast [tablelist::getTablelistPath %W] last } bind TablelistBody { set tablelist::W [tablelist::getTablelistPath %W] tablelist::beginSelect $tablelist::W \ [$tablelist::W index active] [$tablelist::W columnindex active] } bind TablelistBody