Posted to tcl by emiliano at Fri Sep 04 18:20:47 GMT 2009view pretty

#!/usr/bin/env tclsh

package require Tk
package require tile
ttk::style theme use alt
 
# ----------------------------------------------------------------
proc  p.makewindow  {}  	{ 
	eval destroy [winfo children .]
	catch { destroy .topw error_topw }
	set ::topw [ toplevel .topw -background #c0c0c0 ]
	wm withdraw .
	wm geometry $::topw 400x200+20+20
	wm resizable $::topw 1 1
	set  _captionText prototype
	wm title $::topw Prototype
}

# ----------------------------------------------------------------
proc  p.makemenus  {}  	{ 

	# PREPARE MENU...
	$::topw configure -menu $::topw.menubar
	menu $::topw.menubar -font {Arial 13} -bd 1 -tearoff 0
	
	# BUILD TOP ROW...
	$::topw.menubar add cascade \
		-menu $::topw.menubar.file \
		-label File  -font {Arial 13} \
		-underline 0
	menu $::topw.menubar.file \
		-title File  -font {Arial 13} \
		-tearoff 0

	$::topw.menubar.file add command \
		-label  Exit -command  exit
}

# ----------------------------------------------------------------
proc  p.maketext  {}  	{ 

	ttk::frame $::topw.parenttextframe -padding 0
	set  ::parenttext  $::topw.parenttextframe.parenttext
	text $::parenttext
	$::parenttext configure -setgrid true
	$::parenttext configure -wrap word
	$::parenttext configure -yscrollcommand "$::topw.parenttextframe.vscroll set"
	$::parenttext configure -background #ffffff -foreground #000000
	$::parenttext configure -font {Arial 15}
	$::parenttext configure -exportselection 1
	$::parenttext configure -state normal
	$::parenttext configure -undo 1
	
	ttk::scrollbar $::topw.parenttextframe.vscroll -orient vertical -command [list $::parenttext yview]

	ttk::frame $::topw.status -padding 0
	ttk::label $::topw.status.bar1
		$::topw.status.bar1 configure -font {Arial 13}
		$::topw.status.bar1 configure -background #c0c0c0
		$::topw.status.bar1 configure -foreground #000000
		$::topw.status.bar1 configure -relief ridge
		$::topw.status.bar1 configure -anchor w
		$::topw.status.bar1 configure -text "Status bar"

	pack $::topw.parenttextframe -fill both -expand 1
	pack $::parenttext -side left -fill both -expand 1
	pack $::topw.parenttextframe.vscroll -side right -fill y
	
	pack $::topw.status -fill both -expand 0
	pack $::topw.status.bar1 -side left -fill both -expand 1


	set  ::popup  $::parenttext.popuptext
	text $::popup
	$::popup configure -setgrid true
	$::popup configure -wrap word
	$::popup configure -background #FF8080 -foreground #000000
	$::popup configure -font {Arial 15}
	$::popup configure -height 2

}

# ----------------------------------------------------------------
p.makewindow
p.makemenus
p.maketext

# ----------------------------------------------------------------
bind $parenttext	<Key-F1>		{ appear }
bind $parenttext	<Key-F2>		{ disappear }

# ----------------------------------------------------------------
proc  appear  {}  	{
	$::popup delete 1.0 end
	$::parenttext window create insert -window $::popup
	$::popup insert end "Why doesn't this popup appear at the current line instead of at the top?"
}

proc  disappear  {}  	{
	$::popup delete 1.0 end
	$::parenttext window configure $::popup -window {}
}

# ----------------------------------------------------------------
$::parenttext insert end "Move the caret around the text and press F1 and F2.\n\n"
for {set i 1} {$i <= 20} {incr i} 	{
	$::parenttext insert end "This is a sample paragraph, just meant to fill up the text widget with some text.\n\n"
}
focus $::parenttext
$::parenttext mark set insert 1.end