Posted to tcl by emiliano at Fri Sep 04 18:20:47 GMT 2009view raw
- #!/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