#============================================================================== # Contains the implementation of the tablelist move and movecolumn subcommands. # # Copyright (c) 2003-2006 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== #------------------------------------------------------------------------------ # tablelist::moveSubCmd # # This procedure is invoked to process the tablelist move subcommand. #------------------------------------------------------------------------------ proc tablelist::moveSubCmd {win source target} { variable canElide variable elide upvar ::tablelist::ns${win}::data data if {$data(isDisabled) || $data(itemCount) == 0} { return "" } # # Adjust the indices to fit within the existing items and check them # if {$source > $data(lastRow)} { set source $data(lastRow) } elseif {$source < 0} { set source 0 } if {$target > $data(itemCount)} { set target $data(itemCount) } elseif {$target < 0} { set target 0 } if {$target == $source} { return -code error \ "cannot move item with index \"$source\" before itself" } elseif {$target == $source + 1} { return "" } # # Save some data of the edit window if present # if {[set editCol $data(editCol)] >= 0} { set editRow $data(editRow) set editKey $data(editKey) saveEditData $win } # # Build the list of column indices of the selected cells # within the source line and then delete that line # set w $data(body) set selectedCols {} set line [expr {$source + 1}] set textIdx [expr {double($line)}] for {set col 0} {$col < $data(colCount)} {incr col} { if {$data($col-hide) && !$canElide} { continue } if {[lsearch -exact [$w tag names $textIdx] select] >= 0} { lappend selectedCols $col } set textIdx [$w search $elide "\t" $textIdx+1c $line.end]+1c } $w delete [expr {double($source + 1)}] [expr {double($source + 2)}] # # Insert the source item before the target one # set target1 $target if {$source < $target} { incr target1 -1 } set targetLine [expr {$target1 + 1}] $w insert $targetLine.0 "\n" set snipStr $data(-snipstring) set sourceItem [lindex $data(itemList) $source] if {[lsearch -exact $data(fmtCmdFlagList) 1] >= 0} { set formattedItem \ [formatItem $win [lrange $sourceItem 0 $data(lastCol)]] } else { set formattedItem [lrange $sourceItem 0 $data(lastCol)] } set key [lindex $sourceItem end] array set itemData [array get data $key*-\[bf\]*] ;# for speed set rowTags {} foreach name [array names itemData $key-\[bf\]*] { set tail [lindex [split $name "-"] 1] lappend rowTags row-$tail-$itemData($name) } set col 0 foreach text [strToDispStr $formattedItem] \ colTags $data(colTagsList) \ {pixels alignment} $data(colList) { if {$data($col-hide) && !$canElide} { incr col continue } # # Adjust the cell text and the image or window width # if {[string match "*\n*" $text]} { set multiline 1 set list [split $text "\n"] } else { set multiline 0 } set aux [getAuxData $win $key $col auxType auxWidth] set cellFont [getCellFont $win $key $col] if {$pixels == 0} { ;# convention: dynamic width if {$data($col-maxPixels) > 0} { if {$data($col-reqPixels) > $data($col-maxPixels)} { set pixels $data($col-maxPixels) } } } if {$pixels != 0} { incr pixels $data($col-delta) } if {$multiline} { adjustMlElem $win list auxWidth $cellFont \ $pixels $alignment $snipStr set msgScript [list ::tablelist::displayText $win $key \ $col [join $list "\n"] $cellFont $alignment] } else { adjustElem $win text auxWidth $cellFont $pixels $alignment $snipStr } # # Insert the text and the auxiliary object # set cellTags {} foreach name [array names itemData $key-$col-\[bf\]*] { set tail [lindex [split $name "-"] 2] lappend cellTags cell-$tail-$itemData($name) } set tagNames [concat $colTags $rowTags $cellTags] if {$auxType == 0} { if {$multiline} { $w insert $targetLine.end "\t\t" $tagNames $w window create $targetLine.end-1c -pady 1 -create $msgScript } else { $w insert $targetLine.end "\t$text\t" $tagNames } } else { $w insert $targetLine.end "\t\t" $tagNames createAuxObject $win $key $source $col $aux $auxType $auxWidth if {$multiline} { insertMlElem $w $targetLine.end-1c $msgScript \ $aux $auxType $alignment } else { insertElem $w $targetLine.end-1c $text $aux $auxType $alignment } } incr col } # # Update the item list # set data(itemList) [lreplace $data(itemList) $source $source] if {$target == $data(itemCount)} { lappend data(itemList) $sourceItem ;# this works much faster } else { set data(itemList) [linsert $data(itemList) $target1 $sourceItem] } # # Update the list variable if present # if {$data(hasListVar)} { upvar #0 $data(-listvariable) var trace vdelete var wu $data(listVarTraceCmd) set var [lreplace $var $source $source] set pureSourceItem [lrange $sourceItem 0 $data(lastCol)] if {$target == $data(itemCount)} { lappend var $pureSourceItem ;# this works much faster } else { set var [linsert $var $target1 $pureSourceItem] } trace variable var wu $data(listVarTraceCmd) } # # Update anchorRow and activeRow if needed # if {$data(anchorRow) == $source} { set data(anchorRow) $target1 } if {$data(activeRow) == $source} { set data(activeRow) $target1 } # # Invalidate the list of the row indices indicating the non-hidden rows # set data(nonHiddenRowList) {-1} # # Restore the stripes in the body text widget # makeStripesWhenIdle $win # # Select those source elements that were selected before # foreach col $selectedCols { cellselectionSubCmd $win set $target1 $col $target1 $col } # # Restore the edit window if it was present before # if {$editCol >= 0} { if {$editRow == $source} { editcellSubCmd $win $target1 $editCol 1 } else { set data(editRow) [lsearch $data(itemList) "* $editKey"] } } # # Adjust the elided text # adjustElidedTextWhenIdle $win return "" } #------------------------------------------------------------------------------ # tablelist::movecolumnSubCmd # # This procedure is invoked to process the tablelist movecolumn subcommand. #------------------------------------------------------------------------------ proc tablelist::movecolumnSubCmd {win source target} { upvar ::tablelist::ns${win}::data data if {$data(isDisabled)} { return "" } # # Check the indices # if {$target == $source} { return -code error \ "cannot move column with index \"$source\" before itself" } elseif {$target == $source + 1} { return "" } # # Update the column list # set source3 [expr {3*$source}] set source3Plus2 [expr {$source3 + 2}] set target1 $target set target3 [expr {3*$target}] if {$source < $target} { incr target1 -1 incr target3 -3 } set sourceRange [lrange $data(-columns) $source3 $source3Plus2] set data(-columns) [lreplace $data(-columns) $source3 $source3Plus2] set data(-columns) [eval linsert {$data(-columns)} $target3 $sourceRange] # # Save some elements of data corresponding to source # array set tmp [array get data $source-*] array set tmp [array get data k*-$source-*] foreach specialCol {activeCol anchorCol editCol} { set tmp($specialCol) $data($specialCol) } set selCells [curcellselectionSubCmd $win] set tmpRows [extractColFromCellList $selCells $source] # # Remove source from the list of stretchable columns # if it was explicitly specified as stretchable # if {[string first $data(-stretch) "all"] != 0} { set sourceIsStretchable 0 set stretchableCols {} foreach elem $data(-stretch) { if {[string first $elem "end"] != 0 && $elem == $source} { set sourceIsStretchable 1 } else { lappend stretchableCols $elem } } set data(-stretch) $stretchableCols } # # Build two lists of column numbers, neeeded # for shifting some elements of the data array # if {$source < $target} { for {set n $source} {$n < $target1} {incr n} { lappend oldCols [expr {$n + 1}] lappend newCols $n } } else { for {set n $source} {$n > $target} {incr n -1} { lappend oldCols [expr {$n - 1}] lappend newCols $n } } # # Remove the trace from the array element data(activeCol) because otherwise # the procedure moveColData won't work if the selection type is cell # trace vdelete data(activeCol) w [list tablelist::activeTrace $win] # # Move the elements of data corresponding to the columns in oldCols to the # elements corresponding to the columns with the same indices in newCols # foreach oldCol $oldCols newCol $newCols { moveColData $win data data imgs $oldCol $newCol set selCells [replaceColInCellList $selCells $oldCol $newCol] } # # Move the elements of data corresponding to # source to the elements corresponding to target1 # moveColData $win tmp data imgs $source $target1 set selCells [deleteColFromCellList $selCells $target1] foreach row $tmpRows { lappend selCells $row,$target1 } # # If the column given by source was explicitly specified as # stretchable then add target1 to the list of stretchable columns # if {[string first $data(-stretch) "all"] != 0 && $sourceIsStretchable} { lappend data(-stretch) $target1 sortStretchableColList $win } # # Update the item list # set newItemList {} foreach item $data(itemList) { set sourceText [lindex $item $source] set item [lreplace $item $source $source] set item [linsert $item $target1 $sourceText] lappend newItemList $item } set data(itemList) $newItemList # # Update the list variable if present # condUpdateListVar $win # # Set up and adjust the columns, and rebuild # the lists of the column fonts and tag names # setupColumns $win $data(-columns) 0 makeColFontAndTagLists $win makeSortAndArrowColLists $win adjustColumns $win {} 0 # # Reconfigure the relevant column labels # foreach col [lappend newCols $target1] { reconfigColLabels $win imgs $col } # # Redisplay the items # redisplay $win 0 $selCells # # Restore the trace set on the array element data(activeCol) # and enforce the execution of the activeTrace command # trace variable data(activeCol) w [list tablelist::activeTrace $win] set data(activeCol) $data(activeCol) return "" }