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