#!/bin/sh
#PostPoint -*- TCL -*- Created: miguel Mar-2001, Modified: miguel ???-2001

#Post widgets:

# UpDownEntry: campo con flechitas de incrmento/decremento
# ScrolledCanvas: canvas con barritas de scroll a la derecha y abajo

##############################
# Funciones que crean un ScrolledCanvas
# donde se pueden meter widgets, ...
#
# CreateScrolledCanvas nombre_de_widget -> retorna el nombre del canvas
# AddToScrolledCanvas nombre_de_widget cosa_a_aņadir -> aņade el widget al canvas
# ResizeScrolledCanvas nombre_de_widget -> redimensiona las barras de scroll
# ResetScrolledCanvas nombre_de_widget -> borra todos los dibujos/windows del canvas
#                                         sin destruir los widgets
##############################

# CCGetRGB { w color} -> dado un color encuentra su #rrggbb
# CCColorActivo { color { factor 17}} -> dado un color #rrggbb lo eleva segun factor
# CCColorSombra { color { factor 17}} ->  dado un color #rrggbb lo eleva segun factor

# SwitchButton { w on_command off_command args} -> crea un button $args
#                        que si se clickea queda apretado y ejecuta on_command y
#                        si se clickea otra vez vuleve como antes y ejecuta off_command
##############################

# GiDPopUpHelp { w args} -> bocado de ayuda ( texto ayuda en args) sobre el widget w
#                           al cabo de un rato aparece la ayuda y despues de otro
#                           rato, dependiendo de la longitud del texto en args,
#                           desaparece, o al moverse el raton.

# UpDownEntry widget_name arguments
#         arguments:
#                    -up-command "command when up button is pressed"
#                    -down-command "command when down button is pressed"
#                    -show-double-buttons          <- shows rapid incrment buttons, by default disabled
#                    -up-up-command "command when up up button is pressed"
#                    -down-down-command "command when down down button is pressed"
#                    -variable variable_for_the_entry
#                    -textvariable variable_for_the_entry
#                    -foreground fore_color_for_entry_and_buttons
#                    -background back_color_for_entry_and_buttons
#                    -up-color fore_color_for_bitmap_on_up_button
#                    -up-up-color fore_color_for_bitmap_on_up_up_button
#                    -down-color fore_color_for_bitmap_on_down__button
#                    -down-down-color fore_color_for_bitmap_on_down_down_button
#                    -entry-options "Options for the entry widget"
#                    -button-options "Options for the button widgets"
#                    -up-button-options "Options for the up button widget"
#                    -down-button-options "Options for the down button widget"
#                    -up-up-button-options "Options for the up up button widget"
#                    -down-down-button-options "Options for the down down button widget"

# UpDownEntryConf widget_name arguments
#         argumenst:
#                    -state normal/disabled
#                    -foreground fore_color_for_entry_and_buttons
#                    -background back_color_for_entry_and_buttons
#                    -entry-options "Options for the entry widget"
#                    -button-options "Options for the button widgets"
#                    -up-button-options "Options for the up button widget"
#                    -down-button-options "Options for the down button widget"

# proc TextWindow wparent varname title label_text args 
#         displays a window asking for some text which is stored in 'varname'
#         it waits until the user click on 'Apply' or 'Close'
#         there is a couple of bindings:
#         <Alt-Return> and <Alt-KP_Enter> which invoques the 'Apply' button
#         <Escape> which invoques the 'Colse' button
#         argumenst:
#                    wparent - parent window to appear over tit
#                    varname - variable with the text to be showed / edited
#                    title - title of the window
#                    label_text - text of the label wich appears on the surrounding frame
#                    args - arguments passed directly to the text widget
#         returns the window name
##########################################################################################
### ScrolledCanvas
##########################################################################################

proc CreateScrolledCanvas { { w .scw}} {
    if { [ winfo exist $w]} { 
	puts "widget name $w already exists."
	return
    }

    frame $w -relief ridge -bd 2
    set v [ scrollbar $w.vscroll -highlightthickness 0 -bd 1 -elementborderwidth 1 \
	    -orient vertical]
    set h [ scrollbar $w.hscroll -highlightthickness 0 -bd 1 -elementborderwidth 1 \
	    -orient horizontal]
    set c [ canvas $w.c -width 100 -height 100 -borderwidth 2 \
	    -xscrollcommand "$h set" -yscrollcommand "$v set"]
    $h config -command "$c xview"
    $v config -command "$c yview"
    $c config -scrollregion [ $c bbox all]
    grid $c -column 0 -row 0 -sticky news
    grid $v -column 1 -row 0 -rowspan 2 -sticky ns
    grid $h -column 0 -row 1 -sticky ew
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1

    return $w.c
}

proc AddToScrolledCanvas { { w .scw} { what ""}} {
    if { ![ winfo exist $w]} { 
	puts "widget name $w does not exists."
	return
    }

    if { "$what" == ""} {
	puts "Nothing to add to the Scrolled Canvas"
	return
    }

    update idletasks

    set region [ $w.c bbox all]
    set posx 0
    if { [ llength $region] == 4 } {
	set posx [ lindex $region 3]
    }

    $w.c create window 0 $posx -anchor nw -window $what
    $w.c config -scrollregion [ $w.c bbox all]
}

proc ResetScrolledCanvas { { w .scw}} {
    if { ![ winfo exist $w]} { 
	puts "widget name $w does not exists."
	return
    }

    $w.c del all
    $w.c config -scrollregion [ $w.c bbox all]
}

proc ResizeScrolledCanvas { { w .scw}} {
    if { ![ winfo exist $w]} { 
	puts "widget name $w does not exists."
	return
    }

    $w.c config -scrollregion [ $w.c bbox all]
}

##########################################################################################
### UpDownEntry
##########################################################################################

proc UpDownEntry { w args} {
    global UpDownEntry

    set flags_entry ""
    set flags_up_button ""
    set flags_down_button ""
    set up_command ""
    set down_command ""
    set flags_up_up_button ""
    set flags_down_down_button ""
    set up_up_command ""
    set down_down_command ""
    set variable_entry ""
    set show_double_buttons 0
    set up_color black
    set up_up_color black
    set down_color black
    set down_down_color black

    set ll [ llength $args]
    for { set i 0} { $i < $ll} { incr i} {
	# parejas "-opcion cosas"
	set toca [ lindex $args $i]
	incr i
	if { $i >= $ll} { break}
	switch -- "$toca" {
	    "-up-command" {
		set up_command [ lindex $args $i]
	    }
	    "-down-command" {
		set down_command [ lindex $args $i]
	    }
	    "-show-double-buttons" {
		set show_double_buttons 1
		set i [ expr $i - 1]
	    }
	    "-up-up-command" {
		set up_up_command [ lindex $args $i]
	    }
	    "-down-down-command" {
		set down_down_command [ lindex $args $i]
	    }
	    "-variable" {
		set variable_entry [ lindex $args $i]
	    }
	    "-textvariable" {
		set variable_entry [ lindex $args $i]
	    }
	    "-entry-options" {
		append flags_entry " [ lindex $args $i]"
	    }
	    "-button-options" {
		append flags_up_button " [ lindex $args $i]"
		append flags_down_button " [ lindex $args $i]"
		append flags_up_up_button " [ lindex $args $i]"
		append flags_down_down_button " [ lindex $args $i]"
	    }
	    "-up-button-options" {
		append flags_up_button " [ lindex $args $i]"
	    }
	    "-down-button-options" {
		append flags_down_button " [ lindex $args $i]"
	    }
	    "-up-up-button-options" {
		append flags_up_up_button " [ lindex $args $i]"
	    }
	    "-down-down-button-options" {
		append flags_down_down_button " [ lindex $args $i]"
	    }
	    "-foreground" {
		append flags_entry " -foreground [ lindex $args $i]"
		append flags_up_button " -foreground [ lindex $args $i]"
		append flags_down_button " -foreground [ lindex $args $i]"
		append flags_up_up_button " -foreground [ lindex $args $i]"
		append flags_down_down_button " -foreground [ lindex $args $i]"
	    }
	    "-background" {
		append flags_entry " -background [ lindex $args $i]"
		append flags_up_button " -background [ lindex $args $i]"
		append flags_down_button " -background [ lindex $args $i]"
		append flags_up_up_button " -background [ lindex $args $i]"
		append flags_down_down_button " -background [ lindex $args $i]"
	    }
	    "-up-color" {
		set up_color [ lindex $args $i]
	    }
	    "-down-color" {
		set down_color [ lindex $args $i]
	    }
	    "-up-up-color" {
		set up_up_color [ lindex $args $i]
	    }
	    "-down-down-color" {
		set down_down_color [ lindex $args $i]
	    }
	}
    }

    frame $w -bd 0
    entry $w.e
    if { "$variable_entry" != ""} {
	$w.e conf -textvariable $variable_entry
    }
    if { "$flags_entry" != ""} {
	eval [ concat $w.e conf $flags_entry]
    }
    
    if { ![info exist UpDownEntry(triangle_up_image,$up_color)] } {
	set UpDownEntry(triangle_up_image,$up_color) [ image create bitmap -data {
	    #define triangle_up_width 15
	    #define triangle_up_height 9
	    static unsigned char triangle_up_bits[] = {
		0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07,
		0xf8, 0x0f, 0x00, 0x00, 0x00, 0x00};
	    } -foreground $up_color ]
    }

    if { ![info exist UpDownEntry(triangle_down_image,$down_color)] } {
	set UpDownEntry(triangle_down_image,$down_color) [ image create bitmap -data {
	    #define triangle_down_width 15
	    #define triangle_down_height 9
	    static unsigned char triangle_down_bits[] = {
		0x00, 0x00, 0x00, 0x00, 0xf8, 0x0f, 0xf0, 0x07, 0xe0, 0x03, 0xc0, 0x01,
		0x80, 0x00, 0x00, 0x00, 0x00, 0x00};
	    } -foreground $down_color ]
    }

    if { ![info exist UpDownEntry(triangle_up_up_image,$up_up_color)] } {
	set UpDownEntry(triangle_up_up_image,$up_up_color) [ image create bitmap -data {
	    #define triangle_up_up_width 15
	    #define triangle_up_up_height 9
	    static unsigned char triangle_up_up_bits[] = {
		0x00, 0x00, 0x80, 0x00, 0x40, 0x01, 0x20, 0x02, 0x90, 0x04, 0xc8, 0x09,
		0xe4, 0x13, 0x00, 0x00, 0x00, 0x00};
	    } -foreground $up_up_color ]
    }

    if { ![info exist UpDownEntry(triangle_down_down_image,$down_down_color)] } {
	set UpDownEntry(triangle_down_down_image,$down_down_color) [ image create bitmap -data {
	    #define triangle_down_down_width 15
	    #define triangle_down_down_height 9
	    static unsigned char triangle_down_down_bits[] = {
		0x00, 0x00, 0x00, 0x00, 0xe4, 0x13, 0xc8, 0x09, 0x90, 0x04, 0x20, 0x02,
		0x40, 0x01, 0x80, 0x00, 0x00, 0x00};
	    } -foreground $down_down_color ]
    }

    frame $w.fb -bd 0
    button $w.fb.up -image $UpDownEntry(triangle_up_image,$up_color)
    if { "$up_command" != ""} {
	$w.fb.up conf -command $up_command
    }
    if { "$flags_up_button" != ""} {
	eval [ concat $w.fb.up conf $flags_up_button]
    }

    button $w.fb.down -image $UpDownEntry(triangle_down_image,$down_color)
    if { "$down_command" != ""} {
	$w.fb.down conf -command $down_command
    }
    if { "$flags_down_button" != ""} {
	eval [ concat $w.fb.down conf $flags_down_button]
    }

    if { $show_double_buttons} {
	button $w.fb.upup -image $UpDownEntry(triangle_up_up_image,$up_up_color)
	if { "$up_up_command" != ""} {
	    $w.fb.upup conf -command $up_up_command
	}
	if { "$flags_up_up_button" != ""} {
	    eval [ concat $w.fb.upup conf $flags_up_up_button]
	}
	
	button $w.fb.downdown -image $UpDownEntry(triangle_down_down_image,$down_down_color)
	if { "$down_down_command" != ""} {
	    $w.fb.downdown conf -command $down_down_command
	}
	if { "$flags_down_down_button" != ""} {
	    eval [ concat $w.fb.downdown conf $flags_down_down_button]
	}
    }

    grid $w.fb.up -row 0 -column 0
    grid $w.fb.down -row 1 -column 0
    if { $show_double_buttons} {
	grid $w.fb.upup -row 0 -column 1
	grid $w.fb.downdown -row 1 -column 1
    }

    grid $w.e -sticky ew -row 0 -column 0
    grid $w.fb -sticky ns -row 0 -column 1
    grid rowconfigure $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1

    set UpDownEntry(ShowDoubles) $show_double_buttons
}

proc UpDownEntryConf { w args} {
    global UpDownEntry

    set flags_entry ""
    set flags_up_button ""
    set flags_down_button ""
    set flags_up_up_button ""
    set flags_down_down_button ""
    set flag_estado ""

    set ll [ llength $args]
    for { set i 0} { $i < $ll} { incr i} {
	# parejas "-opcion cosas"
	set toca [ lindex $args $i]
	incr i
	if { $i >= $ll} { break}
	switch -- "$toca" {
	    "-state" {
		set flag_estado [ lindex $args $i]
	    }
	    "-entry-options" {
		append flags_entry " [ lindex $args $i]"
	    }
	    "-button-options" {
		append flags_up_button " [ lindex $args $i]"
		append flags_down_button " [ lindex $args $i]"
		append flags_up_up_button " [ lindex $args $i]"
		append flags_down_down_button " [ lindex $args $i]"
	    }
	    "-up-button-options" {
		append flags_up_button " [ lindex $args $i]"
	    }
	    "-down-button-options" {
		append flags_down_button " [ lindex $args $i]"
	    }
	    "-up-up-button-options" {
		append flags_up_up_button " [ lindex $args $i]"
	    }
	    "-down-down-button-options" {
		append flags_down_down_button " [ lindex $args $i]"
	    }
	    "-foreground" {
		append flags_entry " -foreground [ lindex $args $i]"
		append flags_up_button " -foreground [ lindex $args $i]"
		append flags_down_button " -foreground [ lindex $args $i]"
		append flags_up_up_button " -foreground [ lindex $args $i]"
		append flags_down_down_button " -foreground [ lindex $args $i]"
	    }
	    "-background" {
		append flags_entry " -background [ lindex $args $i]"
		append flags_up_button " -background [ lindex $args $i]"
		append flags_down_button " -background [ lindex $args $i]"
		append flags_up_up_button " -background [ lindex $args $i]"
		append flags_down_down_button " -background [ lindex $args $i]"
	    }
	}
    }

    switch "$flag_estado" {
	"normal" {
	    $w.e conf -state normal
	    $w.fb.up conf -state normal
	    $w.fb.down conf -state normal
	    if { $UpDownEntry(ShowDoubles)} {
		$w.fb.upup conf -state normal
		$w.fb.downdown conf -state normal
	    }
	}
	"disabled" {
	    $w.e conf -state disabled
	    $w.fb.up conf -state disabled
	    $w.fb.down conf -state disabled
	    if { $UpDownEntry(ShowDoubles)} {
		$w.fb.upup conf -state disabled
		$w.fb.downdown conf -state disabled
	    }
	}
    }

    if { "$flags_entry" != ""} {
	eval [ concat $w.e conf $flags_entry]
    }

    if { "$flags_up_button" != ""} {
	eval [ concat $w.fb.up conf $flags_up_button]
    }

    if { "$flags_down_button" != ""} {
	eval [ concat $w.fb.down conf $flags_down_button]
    }

    if { $UpDownEntry(ShowDoubles)} {
	if { "$flags_up_up_button" != ""} {
	    eval [ concat $w.fb.upup conf $flags_up_up_button]
	}
	
	if { "$flags_down_down_button" != ""} {
	    eval [ concat $w.fb.downdown conf $flags_down_down_button]
	}
    }
}


proc HidePopUpHelp { w} {
    global GiDPrivPopUpHelp

    if { [ info exist GiDPrivPopUpHelp($w)]} {
	while { "$GiDPrivPopUpHelp($w)" == "Busy"} {
	    update idletasks
	    after 100
	}
	if { [ info exist GiDPrivPopUpHelp($w)]} {
	    after cancel $GiDPrivPopUpHelp($w)
	}   
    }

    set GiDPrivPopUpHelp($w) Busy

    if { [ winfo exist $w.__popup_help]} {
	destroy $w.__popup_help
    }

    bind $w <Motion> ""
    bind $w <Button-3> ""
    unset GiDPrivPopUpHelp($w)
}

proc ShowPopUpHelp { w hide_delay text } {
    global GiDPrivPopUpHelp

    if { [ info exist GiDPrivPopUpHelp($w)]} {
	if { "$GiDPrivPopUpHelp($w)" == "Busy"} {
	    return
	}
	#while { "$GiDPrivPopUpHelp($w)" == "Busy"} {
	#    update idletasks
	#    after 100
	#}
	after cancel $GiDPrivPopUpHelp($w)
    }
    set GiDPrivPopUpHelp($w) Busy

    if { [ winfo exist $w.__popup_help]} {
	destroy $w.__popup_help
    }

    if { ![ winfo exist $w]} {
	return
    }
    
    set x [winfo pointerx $w]
    set y [winfo pointery $w]

    if { $y < [expr [winfo screenheight $w]/2.0] } {
	set y +[expr $y+3]
    } else {
	set y -[expr [winfo screenheight $w]-$y+3]
    }
    if { $x < [expr [winfo screenwidth $w]/2.0] } {
	set x +[expr $x+3]
    } else {
	set x -[expr [winfo screenwidth $w]-$x+3]
    }
    
    toplevel $w.__popup_help

    wm overrideredirect $w.__popup_help 1
    wm geom $w.__popup_help $x$y
    label $w.__popup_help.l -bg #fff7e7 -fg black \
	    -justify left -text $text -wraplength 10c
    #  -relief ridge
    pack $w.__popup_help.l

    set GiDPrivPopUpHelp($w) [ after $hide_delay "HidePopUpHelp $w"]
    bind $w <Motion> "HidePopUpHelp $w"
    bind $w <Button-3> "HidePopUpHelp $w"
}

proc ShowPopUpHelpDelayed { w delay hide_delay text} {
    global GiDPrivPopUpHelp

    set par [ winfo parent $w]
    set top [ winfo toplevel $w]
    while { ( "$par" != "") && ( $par != $top)} {
	if { [ info exist GiDPrivPopUpHelp($par)]} {
	    while { "$GiDPrivPopUpHelp($par)" == "Busy"} {
		update idletasks
		after 100
	    }
	    after cancel $GiDPrivPopUpHelp($par)
	}
	if { [ winfo exist $par.__popup_help]} {
	    destroy $par.__popup_help
	}
	set par [ winfo parent $par]
    }

    set GiDPrivPopUpHelp($w) [ after $delay "ShowPopUpHelp $w $hide_delay \"$text\""]
    bind $w <Button-3> "ShowPopUpHelp $w $hide_delay \"$text\""
}

proc GiDPopUpHelp { w args } {
    global GiDPrivPopUpHelp
    #set hide_delay 3000
    # el tiempo durante el cual se muestra el mensaje
    #set hide_delay [ expr int( 1100 * [llength [ join $args ]] / 3)]
    set hide_delay [ expr int( 500 * [string length [ join $args ]] / 3)]
    if { $hide_delay < 3000} { 
	set hide_delay 3000
    }
    if { [ llength $args] > 1} {
	if { [ regexp {^([0-9]+)$} [ lindex $args 0] dum del] } {
	    if { $del > 0} { 
		set hide_delay $del
		set args [ lrange $args 1 end]
	    }
	}
    }

    bind $w <Enter> "+ShowPopUpHelpDelayed $w 1500 $hide_delay \"[ join $args]\""
    bind $w <Leave> "+HidePopUpHelp $w"
    bind $w <Motion> "+HidePopUpHelp $w"
    bind $w <ButtonPress-1> "+HidePopUpHelp $w"
    bind $w <ButtonPress-2> "+HidePopUpHelp $w"
    #bind $w <ButtonPress-3> "+HidePopUpHelp $w"
    bind $w <Button-1> "+HidePopUpHelp $w"
    bind $w <Button-2> "+HidePopUpHelp $w"
    #bind $w <Button-3> "+HidePopUpHelp $w"
    #bind $w <Button-3> "ShowPopUpHelp $w $hide_delay \"[ join $args]\""
    #foreach ww [ winfo children $w] {
    #	 bind $ww <Enter> "+ShowPopUpHelpDelayed $w 1500 $hide_delay \"[ join $args]\""
    #	 bind $ww <Leave> "+HidePopUpHelp $w"
    #	 bind $ww <Motion> "+HidePopUpHelp $w"
    #	 bind $ww <ButtonPress-1> "+HidePopUpHelp $w"
    #	 bind $ww <ButtonPress-2> "+HidePopUpHelp $w"
    #	 #bind $w <ButtonPress-3> "+HidePopUpHelp $w"
    #	 bind $ww <Button-1> "+HidePopUpHelp $w"
    #	 bind $ww <Button-2> "+HidePopUpHelp $w"
    #	 #bind $w <Button-3> "+HidePopUpHelp $w"
    #	 bind $ww <Button-3> "ShowPopUpHelp $w $hide_delay \"[ join $args]\""
    #}
}



##########################################################################################
### CCGetRGB CCColorActivo CCColorSombra -> para ContourColores
##########################################################################################

proc CCGetRGB { w color} {
    set ret $color
    set n [ scan $color #%2x%2x%2x r g b]
    if { $n != 3} {
	set rgb [ winfo rgb $w $color]
	set r [ expr int( 0.5 + [ lindex $rgb 0]/256.0)]
	set g [ expr int( 0.5 + [ lindex $rgb 1]/256.0)]
	set b [ expr int( 0.5 + [ lindex $rgb 2]/256.0)]
	set ret [ format #%2x%2x%2x $r $g $b]
    }
    return $ret
}

proc CCColorActivo { color_usuario { factor 17} } {
    set ret $color_usuario
    catch {
	set color_nuevo [ CCGetRGB . $color_usuario]
	set n [ scan $color_nuevo #%2x%2x%2x r g b]
	if { $n == 3} {
	    set r [ expr $r + $factor]
	    if { $r > 255} { set r 255}
	    set g [ expr $g + $factor]
	    if { $g > 255} { set g 255}
	    set b [ expr $b + $factor]
	    if { $b > 255} { set b 255}
	    set ret [ format #%2x%2x%2x $r $g $b]
	}
    }
    return $ret
}

proc CCColorSombra { color_usuario { factor 17} } {
    set ret $color_usuario
    catch {
	set color_nuevo [ CCGetRGB . $color_usuario]
	set n [ scan $color_nuevo #%2x%2x%2x r g b]
	if { $n == 3} {
	    set r [ expr $r - $factor]
	    if { $r < 0} { set r 0}
	    set g [ expr $g - $factor]
	    if { $g < 0} { set g 0}
	    set b [ expr $b - $factor]
	    if { $b < 0} { set b 0}
	    set ret [ format #%2x%2x%2x $r $g $b]
	}
    }
    return $ret
}

##########################################################################################
### Switch Button
##########################################################################################

proc SwitchButtonOn { w } {
    global SwitchButton

    set ret [ eval $SwitchButton($w,on_cmd)]

    if { "[ string tolower $ret]" != "error"} {
	$w conf -foreground $SwitchButton($w,activeforeground) \
		-background $SwitchButton($w,activebackground) \
		-relief sunken

	$w invoke
	bind $w <1> "SwitchButtonOff $w; break"
    }
}

proc SwitchButtonOff { w } {
    global SwitchButton    

    set ret [ eval $SwitchButton($w,off_cmd)]

    if { "[ string tolower $ret]" != "error"} {    
	$w conf -foreground $SwitchButton($w,foreground) \
		-background $SwitchButton($w,background) \
		-relief $SwitchButton($w,relief)
	
	bind $w <1> "SwitchButtonOn $w; break"
    }
}

proc SwitchButton { w on_command off_command args} {
    global SwitchButton

    eval [ concat button $w $args]
    foreach attr "foreground background activeforeground activebackground relief" {
	set SwitchButton($w,$attr) [ $w cget -$attr]
    }
    set SwitchButton($w,on_cmd) $on_command
    set SwitchButton($w,off_cmd) $off_command

    bind $w <1> "SwitchButtonOn $w; break"
}


##########################################################################################
### BotonPlano
##########################################################################################

proc BotonPlano { w texto comando color_fondo_normal color_fondo_activo { color_normal ""} { color_activo ""}} {
    global Plano

    button $w -text $texto -command $comando -bd 0 -background $color_fondo_normal \
	    -highlightthickness 1 -highlightbackground $color_fondo_normal
    set enter_cmd "$w conf -background $color_fondo_activo -highlightbackground #ffffff"
    set leave_cmd "$w conf -background $color_fondo_normal -highlightbackground $color_fondo_normal"
    if { "$color_normal" != ""} {
	$w conf -foreground $color_normal
	append leave_cmd " -foreground $color_normal"
    }
    if { "$color_activo" != ""} {
	append enter_cmd " -foreground $color_activo"
    }
    #-takefocus 0 -bd 1
    bind $w <Enter> $enter_cmd
    bind $w <Leave> $leave_cmd
    set Plano($w,Enter) $enter_cmd
    set Plano($w,Leave) $leave_cmd
}

proc OptionMenuPlano { w variable menu_lst color_fondo_normal color_fondo_activo} {
    global Plano CCOtroLook

    set menu [ eval [ concat tk_optionMenu $w $variable $menu_lst]]
    $w conf -bd 0 -highlightthickness 1 -background $color_fondo_normal
    $menu conf -bd 1 -activeborderwidth 1 -background $color_fondo_normal
    bind $w <Enter> "$w conf -background $color_fondo_activo -highlightbackground #ffffff"
    bind $w <Leave> "$w conf -background $color_fondo_normal -highlightbackground $color_fondo_normal"
    set Plano($w,Enter) "$w conf -background $color_fondo_activo -highlightbackground #ffffff"
    set Plano($w,Leave) "$w conf -background $color_fondo_normal -highlightbackground $color_fondo_normal"
}

proc PlanoConf { w que como} {
    global Plano CCOtroLook

    switch "[ string tolower $que]" {
	"coloractivo" {
	    bind $w <Enter> "$w conf -background $como -highlightbackground #ffffff"
	    set Plano($w,Enter) "$w conf -background $como -highlightbackground #ffffff"
	}
	"colornormal" {
	    $w conf -background $como
	    bind $w <Leave> "$w conf -background $como -highlightbackground $como"
	    set Plano($w,Leave) "$w conf -background $como -highlightbackground $como"
	}
	"estado" {
	    switch "[string tolower $como]" {
		"disabled" {
		    bind $w <Enter> ""
		    bind $w <Leave> ""
		    $w conf -state $como
		}
		"normal" {
		    $w conf -state $como
		    bind $w <Enter> $Plano($w,Enter)
		    bind $w <Leave> $Plano($w,Leave)
		}
	    }
	}
    }
}

proc BWChooseColor { w args} {
    set nuevo [ eval SelectColor::dialog $w $args]
    if { [ string length $nuevo] == 13} { 
	# es de la forma #rrrrggggbbbb -> cada componente 0..65535
	scan $nuevo #%4x%4x%4x r g b
	set r [ expr int( 0.5 + $r * 255.0 / 65535.0)]
	set g [ expr int( 0.5 + $g * 255.0 / 65535.0)]
	set b [ expr int( 0.5 + $b * 255.0 / 65535.0)]
	set nuevo [ format #%02x%02x%02x $r $g $b]
    } 
    return $nuevo
}

proc BWChooseColorMenu { w where args} {
    # where puede ser: [ list { "at" "center" "left" "right" "above" "below"} $widget]

    set nuevo [ eval SelectColor::menu $w [ list $where] $args]
    if { [ string length $nuevo] == 13} { 
	# es de la forma #rrrrggggbbbb -> cada componente 0..65535
	scan $nuevo #%4x%4x%4x r g b
	set r [ expr int( 0.5 + $r * 255.0 / 65535.0)]
	set g [ expr int( 0.5 + $g * 255.0 / 65535.0)]
	set b [ expr int( 0.5 + $b * 255.0 / 65535.0)]
	set nuevo [ format #%02x%02x%02x $r $g $b]
    } 
    return $nuevo
}

proc AjustaPosicion { w parent_w} {
    # ajuste geometria
    wm withdraw $w
    update idletasks

    # # centrada en la pantalla
    # set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
    # 	      - [winfo vrootx [winfo parent $w]]}]
    # set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
    # 	      - [winfo vrooty [winfo parent $w]]}]
    set w2 [ expr [ winfo reqwidth $w] / 2]
    set h2 [ expr [ winfo reqheight $w] / 2]
    set x [ expr [ winfo pointerx $parent_w] - $w2]
    set y [ expr [ winfo pointery $parent_w] - $h2]

    # miramos si sale la X
    set off_scr_x [ expr ( $x + $w2 + $w2) - [ winfo screenwidth $w]]
    if { $off_scr_x >= 0} {
	set x [ expr $x - $off_scr_x - 10]
    }
    if { $x < 0} { set x 0}
    # miramos si sale la Y
    set off_scr_y [ expr ( $y + $h2 + $h2) - [ winfo screenheight $w]]
    if { $off_scr_y >= 0} {
	set y [ expr $y - $off_scr_y - 20]
    }
    if { $y < 0} { set y 0}
    wm geom $w +$x+$y
    wm deiconify $w
}

# otro look
proc ChangeToNewLook { boton} {
    global GidPriv
    
    set par [ winfo parent $boton]
    if { "$par" == ""} { set par .gid}
    set DefaultBG [ $par cget -bg]
    set bdw [ $boton cget -bd]
    if { $bdw > 0} { set bdw [ expr $bdw - 1]}
    set hlt [ $boton cget -highlightthickness]
    incr hlt
    #incr hlt
    $boton conf -bd $bdw -highlightthickness $hlt -highlightbackground $DefaultBG \
        -bg $DefaultBG
    bind $boton	<Enter> "+ %W conf -highlightbackground $GidPriv(ColorBotonMarcoActivo) \
	    -background  $GidPriv(ColorBotonActivo) -state active"
    bind $boton	<Leave> "+ %W conf -highlightbackground $DefaultBG \
	    -background  $DefaultBG"
}

proc TextWindow { wparent varname title label_text args} {
    upvar $varname __textvar

    if { "$wparent" == "."} {
	set w ".__TextWindow"
    } else {
	set w $wparent.__TextWindow
    }
    
    # algo de informacion de los argumentos
    # miramos si es editable
    # si hacen falta las barras de scroll
    set solo_lectura 0
    set hay_barras_scroll 0
    set nargs_1 [ expr [ llength $args] - 1]
    for { set i 0} { $i < $nargs_1} { incr i} {
	set toca [ string tolower [ lindex $args $i]]
	set sig [ string tolower [ lindex $args [ expr $i + 1]]]
	if { ( "$toca" == "-state") && ( "$sig" == "disabled")} {
	    set solo_lectura 1
	}
	if { ( "$toca" == "-wrap") && ( "$sig" == "none")} {
	    set hay_barras_scroll 1
	}
    }


    toplevel $w
    wm title $w $title

    set color_fondo [ CCGetRGB $w [ $w cget -background]]

    # Titulo y descripcion
    TitleFrame $w.tf -text $label_text
    set ftext [ $w.tf getframe]

    if { $hay_barras_scroll} {
	scrollbar $ftext.yscroll -relief sunken -orient vertical \
		-command "$ftext.t1 yview" \
		-bd 1 -elementborderwidth 1 -takefocus 0
	scrollbar $ftext.xscroll -relief sunken -orient horizontal \
		-command "$ftext.t1 xview" \
		-bd 1 -elementborderwidth 1 -takefocus 0
	set txt_args "-yscroll \"$ftext.yscroll set\" -xscroll \"$ftext.xscroll set\" -wrap none "
    } else {
	set txt_args " -takefocus 0"
    }
    if { "$args" == ""} { \
	append txt_args " -width 20 -height 3 -bd 1"
    } else {
	append txt_args " $args"
    }
    eval text $ftext.t1 $txt_args
    grid $ftext.t1 -sticky ewns
    if { $hay_barras_scroll} {
	grid  $ftext.xscroll -sticky ew
	grid  $ftext.yscroll -rowspan 2 -row 0 -column 1 -sticky ns
    }
    grid rowconfigure $ftext 0 -weight 1
    grid columnconfigure $ftext 0 -weight 1

    if { $solo_lectura} {
	# para que podamos aņadir el texto
	$ftext.t1 conf -state normal
    }
    $ftext.t1 del 0.0 end
    $ftext.t1 ins end $__textvar
    if { $solo_lectura} {
	$ftext.t1 conf -state disabled
    }

    ####################################
    ### Botones
    ####################################
    frame $w.botones -bd 0 -background [ CCColorActivo $color_fondo]
    proc ActualizaVariable { var wtext} {
	#upvar $var __tt
	set tmp [ $wtext get 0.0 end]
	# quitamos el lf del final
	set $var [ string range $tmp 0 [ expr [ string length $tmp] - 2]]
    }

    button $w.botones.cerrar -text [_ "Close"] -bd 1 \
	    -command "if { !$solo_lectura} { \
	    bind $ftext.t1 <Alt-Return> {} \
	}; \
	bind $w.tf <Escape> {}; \
	bind $ftext.t1 <Escape> {}; \
	destroy $w"
    
    if { !$solo_lectura} {
	button $w.botones.aceptar -text [_ "Apply"] -bd 1 \
		-command  "ActualizaVariable $varname $ftext.t1 ; after idle destroy $w"
	grid $w.botones.aceptar $w.botones.cerrar -pady 10 -padx 4 -sticky ews
    } else {
	grid $w.botones.cerrar -pady 10 -padx 4 -sticky ews
    }
    
    grid $w.tf -sticky wens -pady 4 -padx 4
    grid $w.botones -sticky sew
    
    grid rowconfigure $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1

    #bind $w.tf <Shift-Return> "$w.botones.aceptar invoke"
    #bind $ftext.t1 <Shift-Return> "$w.botones.aceptar invoke"
    if { !$solo_lectura} {
	bind $ftext.t1 <Alt-Return> "$w.botones.aceptar invoke"
	bind $ftext.t1 <Alt-KP_Enter> "$w.botones.aceptar invoke"
    }
    bind $w.tf <Escape> "$w.botones.cerrar invoke"
    bind $ftext.t1 <Escape> "$w.botones.cerrar invoke"

    if { "$wparent" == "."} {
	set wp2 [ expr [ winfo screenwidth $wparent] / 2]
	set hp2 [ expr [ winfo screenheight $wparent] / 2]
    } else {
	set wp2 [ expr [ winfo width $wparent] / 2]
	set hp2 [ expr [ winfo height $wparent] / 2]
    }

    set cpx [ expr [ winfo rootx $wparent] + $wp2]
    set cpy [ expr [ winfo rooty $wparent] + $hp2]

    set wp2 [ expr [ winfo reqwidth $w] / 2]
    set hp2 [ expr [ winfo reqheight $w] / 2]

    set wx [ expr $cpx - $wp2]
    set wy [ expr $cpy - $hp2]
    if { $wx < 0} { set wx 1}
    if { $wy < 0} { set wy 1}

    wm geometry $w +${wx}+${wy}
    if { !$solo_lectura} {
	focus $ftext.t1
    } else {
	focus $w.botones.cerrar
    }

    tkwait window $w
    return $w
}

