# SpecTcl, by S. A. Uhler and Ken Corey
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# utility routines for extracting table structures

###  This has been replaced by the "blt_table location" extension
# procedure to generate a binary search
#   name: The name of the procedure to generate
#   list: A list of numbers that indicate the size of each bucket
#		 (must have at least 1 element)
#   start: The index of the first bucket
#   level: Used internally for indenting the code
#   result: A string to be "eval'd" to generate the procedure

proc gen_bsearch {name list {start 0} {level 0}} {

	if {!$level} {
		append result "# procedure automatically generated by gen_bsearch\n"
		append result "# Calling sequence: $name <integer>\n"
		append result "# returns bucket number given by:\n"
		append result "#  $list\n\n"
		append result "proc $name  x \{\n"
	}	

	set len [llength $list]
	set pivot [expr [llength $list] / 2]
	set indent [format "%*s" [expr ($level + 1) * 2] ""]

	append result $indent "if \{\$x < [lindex $list $pivot] \} \{\n"

	if {$pivot == 0} {
		# append result "puts stderr \"$name \$x -> $start\"\n"
		append result "$indent  return $start\n"
	} else {
		append result [gen_bsearch $name \
				[lrange $list 0 [expr $pivot - 1]] \
				$start \
				[expr $level + 1]]
	}
	append result "$indent\} else \{\n"
	incr pivot
	if {$len == $pivot } {
		# append result "puts stderr \"$name \$x -> [expr $start + $pivot]\"\n"
		append result "$indent  return [expr $start + $pivot]\n"
	} else {
		append result [gen_bsearch $name \
				[lrange $list $pivot end] \
				[expr $start  + $pivot] \
				[expr $level + 1]]
	}
	append result "$indent\}\n"

	if {!$level} {
		append result \}\n
	}	
	return $result
}

# insert a row or column into the table
#  Table: The parent table to do the inserting in
#  What is "row" or "column"
#  index must be even!
#  count must be even

proc table_insert {table what index {count 2}} {
    global P _Message
    dputs $table $what $index
    undo_log create_grid $table $what $index
    if {[expr $index%2]} {
	puts "table_insert:Ack! index wasn't even!"
    }
    set elems {}
    foreach qq [grid slaves $table] {
	if {![regexp {@} $qq]} {
	    lappend elems $qq
	}
    }

    foreach item $elems {
	blt_get $item info
	set start $info(-$what)
	set end [expr $start + $info(-${what}span) -1]
	if {$end < $index} {
	    continue			;# before insertion - skip
	} 
	if {$start >= $index} {				;# move entire widget
	    incr info(-$what) $count
	} else {							;# shift span
	    incr info(-${what}span) $count
	}
	eval [blt_set $table $item info]
    }
    resize_insert $table $what $index
    return 1
}	

# delete a row or column - only delete empty rows or columns
#  table: parent of the table to operate on
#  what:  "row" or "col"
#  index: table index - MUST be even
#  count: How many to delete - MUST be even
#  return value: TRUE if successful, false if widget would be deleted

proc table_delete {table what index {count 2}} {
    global _Message

    # check for widget that would be deleted, gather info for the rest
    
    dputs $table $what $index
    set elems {}
    foreach qq [grid slaves $table] {
	if {![regexp {@} $qq]} {
	    lappend elems $qq
	}
    }
    foreach item $elems {
	blt_get $item info
	set start $info(-$what)
	set end [expr $start + $info(-${what}span) -1]
	if {$start == $index && $end == $index} {		;# has widget!
	    dputs "No place for $item, aborting"
	    return 0
	} 
	if {$end < $index} {
	    continue
	}
	if {$start > $index} {		;# move entire widget
	    incr info(-$what) -$count
	} else {					;# shift span
	    incr info(-${what}span) -$count
	}
	set eval($item) [blt_set $table $item info]
    }
    
    # OK, now shift everything
    
    foreach item [array names eval] {
	eval $eval($item)
    }
    update_table $table "deleting $what $index"
    resize_delete $table $what $index
    return 1
}	

#   delete a handle

proc highlight_delete {handle} {
	upvar $handle data
	if {![info exists data(HighLightHandle)]} {
		error "$handle is not a highlight handle"
	}
	uplevel "unset $handle"
}



