package require Tk

proc WindowMessage_Configure { f } {

    bind $f <Configure> ""
    grid remove $f.x
    grid remove $f.y

    if { [$f.t xview] != {0 1} } {
 	grid $f.x -row 1 -column 0 -sticky ew
    }
    if { [$f.t yview] != {0 1} } {
 	grid $f.y -row 0 -column 1 -sticky ns
    }
    update
    bind $f <Configure> "WindowMessage_Configure $f"
}

proc WindowMessage_HandleKey { t keysym } {

    switch $keysym {
	KP_Up -
	Up {
	    set view [$t yview]
	    if { [lindex $view 0] != 0 } {
		$t yview scroll -1 units
	    }
	}
	KP_Down -
	Down {
	    set view [$t yview]
	    if { [lindex $view 1] != 1 } {
		$t yview scroll 1 units
	    }
	}
	KP_Left -
	Left {
	    set view [$t xview]
	    if { [lindex $view 1] != 0 } {
		$t xview scroll -1 units
	    }
	}
	KP_Right -
	Right {
	    set view [$t xview]
	    if { [lindex $view 1] != 1 } {
		$t xview scroll 1 units
	    }
	}
	KP_Home -
	Home {
	    set view [$t xview]
	    if { [lindex $view 1] != 0 } {
		$t xview moveto 0
	    }
	}
	KP_End -
	End {
	    set view [$t xview]
	    if { [lindex $view 1] != 1 } {
		$t xview moveto 1
	    }
	}
	KP_Prior -
	Prior {
	    set view [$t yview]
	    if { [lindex $view 0] != 0 } {
		$t yview scroll -1 pages
	    }
	}
	KP_Next -
	Next {
	    set view [$t yview]
	    if { [lindex $view 1] != 1 } {
		$t yview scroll 1 pages
	    }
	}
    }
}


proc WindowMessage { msg {title "Messages"} {w .__winmessage__} } {

    upvar \#0 $w data

    set top $w
    set f $top.f
    set t $f.t
    set x $f.x
    set y $f.y
    set b $f.b

    if [winfo exist $top] {
	incr data(number)
	set first_time 0
    } else {
	set data(number) 1
	toplevel $top
	wm title $top $title
	frame $f -bd 1 -relief solid
	bind $f <Key> "WindowMessage_HandleKey $t %K"
	text $t -xscrollcommand "$x set" -yscrollcommand "$y set" -wrap none
	bind $t <Destroy> "unset $w"
	scrollbar $x -orient horizontal -command "$t xview"
	scrollbar $y -orient vertical   -command "$t yview"
	button $b -command "destroy $top" -text [_ "Close"]
	
	grid $t -row 0 -column 0 -sticky snew
# 	grid $x -row 1 -column 0 -sticky ew
# 	grid $y -row 0 -column 1 -sticky ns
	grid $b -row 2 -column 0
	grid columnconfigure $f 0 -weight 1
	grid rowconfigure    $f 0 -weight 1
	pack $f -fill both -expand yes
	set first_time 1
    }
    $t configure -state normal
    $t insert end "message $data(number): -----------\n"
    regsub -- \n $msg \n\t msg
    $t insert end \n\t${msg}\n\n
    $t configure -state disabled
    update
    if !$first_time {
	WindowMessage_Configure $f
    } else {
	if { [$t xview] != {0 1} } {
	    grid $x -row 1 -column 0 -sticky ew
	}
	if { [$t yview] != {0 1} } {
	    grid $y -row 0 -column 1 -sticky ns
	}
	update
	bind $f <Configure> "WindowMessage_Configure $f"
    }
    focus $f
}