diff options
| -rw-r--r-- | ChangeLog | 21 | ||||
| -rw-r--r-- | library/demos/button.tcl | 16 | ||||
| -rw-r--r-- | library/demos/check.tcl | 5 | ||||
| -rw-r--r-- | library/demos/style.tcl | 25 | ||||
| -rw-r--r-- | library/demos/textpeer.tcl | 60 | ||||
| -rw-r--r-- | library/demos/twind.tcl | 8 | ||||
| -rw-r--r-- | library/demos/widget | 140 |
7 files changed, 172 insertions, 103 deletions
@@ -1,3 +1,12 @@ +2007-10-15 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> + + * library/demos/widget: Use Ttk widgets for the widget demo core, for + vastly improved look-and-feel on at least one platform (Windows). + * library/demos/{button,check,style,twind}.tcl: Various tweaks for + GOOBE... + * library/demos/textpeer.tcl: New demo script to show off peering as a + specific feature. + 2007-10-15 Jeff Hobbs <jeffh@ActiveState.com> * generic/tkFocus.c, generic/tkFrame.c, generic/tkInt.h: @@ -9,10 +18,10 @@ 2007-10-15 Joe English <jenglish@users.sourceforge.net> - * generic/ttk/ttkTreeview.c: Store pointer to column - table entry instead of column index in columnNames hash table. - This avoids the need for the evil PTR2INT and INT2PTR macros, - and simplifies things a bit. + * generic/ttk/ttkTreeview.c: Store pointer to column table entry + instead of column index in columnNames hash table. This avoids the + need for the evil PTR2INT and INT2PTR macros, and simplifies things a + bit. 2007-10-15 Daniel Steffen <das@users.sourceforge.net> @@ -61,7 +70,7 @@ * macosx/tkMacOSXDraw.c: replace all (internal) use of QD region * macosx/tkMacOSXSubwindows.c: API by HIShape API, with conversion to - * macosx/tkMacOSXWindowEvent.c QD regions only when required by legacy + * macosx/tkMacOSXWindowEvent.c: QD regions only when required by legacy * macosx/tkMacOSXPrivate.h: Carbon or Tk API. * macosx/tkMacOSXRegion.c: * macosx/tkMacOSXDebug.c: @@ -126,7 +135,7 @@ * generic/tkImage.c: Make Ttk_GetImage safe if called with NULL * tests/ttk/image.test: interp. Added some tests that crash on Windows without this fix. - + 2007-10-02 Don Porter <dgp@users.sourceforge.net> * generic/tk.h: Bump version number to 8.5b1.1 to distinguish diff --git a/library/demos/button.tcl b/library/demos/button.tcl index 1fbef8d..5833fd0 100644 --- a/library/demos/button.tcl +++ b/library/demos/button.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several button widgets. # -# RCS: @(#) $Id: button.tcl,v 1.6 2007/05/30 13:23:49 das Exp $ +# RCS: @(#) $Id: button.tcl,v 1.7 2007/10/15 21:06:16 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,22 +22,10 @@ label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any pack $w.msg -side top ## See Code / Dismiss buttons -set btns [addSeeDismiss $w.buttons $w] -pack $btns -side bottom -fill x +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x proc colorrefresh {w col} { $w configure -bg $col - $w.buttons configure -bg $col - if {[tk windowingsystem] eq "aqua"} { - # set highlightbackground of all buttons in $w - set l [list $w] - while {[llength $l]} { - set l [concat [lassign $l b] [winfo children $b]] - if {[winfo class $b] eq "Button"} { - $b configure -highlightbackground $col - } - } - } } button $w.b1 -text "Peach Puff" -width 10 \ diff --git a/library/demos/check.tcl b/library/demos/check.tcl index 3e3ddc4..9c39153 100644 --- a/library/demos/check.tcl +++ b/library/demos/check.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a toplevel window containing # several checkbuttons. # -# RCS: @(#) $Id: check.tcl,v 1.5 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: check.tcl,v 1.6 2007/10/15 21:06:17 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -35,6 +35,9 @@ checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat pack $w.b0 -side top -pady 2 -anchor w pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w -padx 15 +## This code makes $w.b0 function as a tri-state button; it's not +## needed at all for just straight yes/no buttons. + set in_check 0 proc tristate_check {n1 n2 op} { global safety wipers brakes sober in_check diff --git a/library/demos/style.tcl b/library/demos/style.tcl index ff31fc6..41c58d7 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget that illustrates the # various display styles that may be set for tags. # -# RCS: @(#) $Id: style.tcl,v 1.4 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: style.tcl,v 1.5 2007/10/15 21:06:17 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -22,17 +22,22 @@ positionWindow $w set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x +# Only set the font family in one place for simplicity and consistency + +set family Courier + text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ - -width 70 -height 32 -wrap word + -width 70 -height 32 -wrap word -font "$family 12" scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both # Set up display styles -$w.text tag configure bold -font {Courier 12 bold italic} -$w.text tag configure big -font {Courier 14 bold} -$w.text tag configure verybig -font {Helvetica 24 bold} +$w.text tag configure bold -font "$family 12 bold italic" +$w.text tag configure big -font "$family 14 bold" +$w.text tag configure verybig -font "Helvetica 24 bold" +$w.text tag configure tiny -font "Times 8 bold" if {[winfo depth $w] > 1} { $w.text tag configure color1 -background #a0b7ce $w.text tag configure color2 -foreground red @@ -53,8 +58,8 @@ $w.text tag configure underline -underline on $w.text tag configure overstrike -overstrike on $w.text tag configure right -justify right $w.text tag configure center -justify center -$w.text tag configure super -offset 4p -font {Courier 10} -$w.text tag configure sub -offset -2p -font {Courier 10} +$w.text tag configure super -offset 4p -font "$family 10" +$w.text tag configure sub -offset -2p -font "$family 10" $w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m $w.text tag configure spacing -spacing1 10p -spacing2 2p \ -lmargin1 12m -lmargin2 6m -rmargin 10m @@ -63,17 +68,17 @@ $w.text insert end {Text widgets like this one allow you to display information variety of styles. Display styles are controlled using a mechanism called } $w.text insert end tags bold -$w.text insert end {. Tags are just textual names that you can apply to one +$w.text insert end {. Tags are just textual names that you can apply to one or more ranges of characters within a text widget. You can configure tags with various display styles. If you do this, then the tagged characters will be displayed with the styles you chose. The available display styles are: } $w.text insert end "\n1. Font." big -$w.text insert end " You can choose any X font, " +$w.text insert end " You can choose any system font, " $w.text insert end large verybig $w.text insert end " or " -$w.text insert end "small.\n" +$w.text insert end "small" tiny ".\n" $w.text insert end "\n2. Color." big $w.text insert end " You can change either the " $w.text insert end background color1 diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl new file mode 100644 index 0000000..0dd23f3 --- /dev/null +++ b/library/demos/textpeer.tcl @@ -0,0 +1,60 @@ +# textpeer.tcl -- +# +# This demonstration script creates a pair of text widgets that can edit a +# single logical buffer. This is particularly useful when editing related text +# in two (or more) parts of the same file. +# +# RCS: @(#) $Id: textpeer.tcl,v 1.1 2007/10/15 21:06:17 dkf Exp $ + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .textpeer +catch {destroy $w} +toplevel $w +wm title $w "Text Widget Peering Demonstration" +wm iconname $w "textpeer" +positionWindow $w + +set count 0 + +set first [text $w.text[incr count]] +$first insert end "This is a coupled pair of text widgets; they are peers to " +$first insert end "each other. They have the same underlying data model, but " +$first insert end "can show different locations, have different current edit " +$first insert end "locations, and have different selections. You can also " +$first insert end "create additional peers of any of these text widgets using " +$first insert end "the Make Peer button beside the text widget to clone, and " +$first insert end "delete a particular peer widget using the Delete Peer " +$first insert end "button." +grid $first + +proc makeClone {w parent} { + global count + set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ + -height 10 -wrap word] + set sb [scrollbar $w.sb$count -command "$t yview" -orient vertical] + set b1 [button $w.clone$count -command "makeClone $w $t" \ + -text "Make Peer"] + set b2 [button $w.kill$count -command "killClone $w $count" \ + -text "Delete Peer"] + set row [expr {$count * 2}] + grid $t $sb $b1 -sticky nsew -row $row + grid ^ ^ $b2 -row [incr row] + grid configure $b1 $b2 -sticky new + grid rowconfigure $w $b2 -weight 1 +} +proc killClone {w count} { + destroy $w.text$count $w.sb$count + destroy $w.clone$count $w.kill$count +} + +makeClone $w $first +makeClone $w $first +destroy $first + +## See Code / Dismiss buttons +grid [addSeeDismiss $w.buttons $w] - - -sticky ew -row 5000 diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index 7510776..b2d35dd 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -3,7 +3,7 @@ # This demonstration script creates a text widget with a bunch of # embedded windows. # -# RCS: @(#) $Id: twind.tcl,v 1.8 2004/12/21 11:56:35 dkf Exp $ +# RCS: @(#) $Id: twind.tcl,v 1.9 2007/10/15 21:06:17 dkf Exp $ if {![info exists widgetDemo]} { error "This script should be run from the \"widget\" demo." @@ -66,7 +66,7 @@ $t insert end "Or, here is another example. If you " $t window create end -create { button %W.click -text "Click Here" -command "textWindPlot %W" \ -cursor top_left_arrow} - + $t insert end " a canvas displaying an x-y plot will appear right here." $t mark set plot insert $t mark gravity plot left @@ -97,6 +97,10 @@ $t window create end \ -cursor top_left_arrow} -padx 3 $t insert end " \n\n" +$t insert end "Users of previous versions of Tk will also be interested " +$t insert end "to note that now cursor movement is now by visual line by " +$t insert end "default, and that all scrolling of this widget is by pixel.\n\n" + $t insert end "You may also find it useful to put embedded windows in " $t insert end "a text without any actual text. In this case the " $t insert end "text widget acts like a geometry manager. For " diff --git a/library/demos/widget b/library/demos/widget index f92d0a7..f86d045 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -3,19 +3,19 @@ exec wish "$0" "$@" # widget -- -# This script demonstrates the various widgets provided by Tk, -# along with many of the features of the Tk toolkit. This file -# only contains code to generate the main window for the -# application, which invokes individual demonstrations. The -# code for the actual demonstrations is contained in separate -# ".tcl" files is this directory, which are sourced by this script -# as needed. +# This script demonstrates the various widgets provided by Tk, along with many +# of the features of the Tk toolkit. This file only contains code to generate +# the main window for the application, which invokes individual +# demonstrations. The code for the actual demonstrations is contained in +# separate ".tcl" files is this directory, which are sourced by this script as +# needed. # -# RCS: @(#) $Id: widget,v 1.30 2007/05/27 13:14:36 das Exp $ +# RCS: @(#) $Id: widget,v 1.31 2007/10/15 21:06:17 dkf Exp $ package require Tcl 8.5 package require Tk 8.5 package require msgcat +package require Ttk eval destroy [winfo child .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] @@ -23,8 +23,8 @@ set tk_demoDirectory [file join [pwd] [file dirname [info script]]] namespace import ::msgcat::mc wm title . [mc "Widget Demonstration"] if {[tk windowingsystem] eq "x11"} { - # This won't work everywhere, but there's no other way in core Tk - # at the moment to display a coloured icon. + # This won't work everywhere, but there's no other way in core Tk at the + # moment to display a coloured icon. image create photo TclPowered \ -file [file join $tk_library images logo64.gif] wm iconwindow . [toplevel ._iconWindow] @@ -37,16 +37,16 @@ if {[lsearch -exact [font names] defaultFont] == -1} { if {[lsearch -exact [font names] TkDefaultFont] != -1 && [lsearch -exact [font names] TkFixedFont] != -1} { # FIX ME: the following tecnique of cloning the font to copy it works - # fine but means that if the system font is changed by - # Tk cannot update the copied font. font alias might be - # useful here -- or fix the app to use TkDefaultFont etc. + # fine but means that if the system font is changed by Tk + # cannot update the copied font. font alias might be useful + # here -- or fix the app to use TkDefaultFont etc. font create mainFont {*}[font configure TkDefaultFont] font create fixedFont {*}[font configure TkFixedFont] font create boldFont {*}[font configure TkDefaultFont] -weight bold font create titleFont {*}[font configure TkDefaultFont] -weight bold font create statusFont {*}[font configure TkDefaultFont] font create varsFont {*}[font configure TkDefaultFont] - } else { + } else { font create mainFont -family Helvetica -size 12 font create fixedFont -family Courier -size 10 font create boldFont -family Helvetica -size 12 -weight bold @@ -108,9 +108,9 @@ image create photo ::img::print -height 19 -format GIF -data { } #---------------------------------------------------------------- -# The code below create the main window, consisting of a menu bar -# and a text widget that explains how to use the program, plus lists -# all of the demos as hypertext items. +# The code below create the main window, consisting of a menu bar and a text +# widget that explains how to use the program, plus lists all of the demos as +# hypertext items. #---------------------------------------------------------------- menu .menuBar -tearoff 0 @@ -136,16 +136,14 @@ if {[tk windowingsystem] eq "aqua"} { . configure -menu .menuBar -frame .statusBar -label .statusBar.lab -text " " -relief sunken -bd 1 \ - -font statusFont -anchor w -label .statusBar.foo -width 8 -relief sunken -bd 1 \ - -font statusFont -anchor w +ttk::frame .statusBar +ttk::label .statusBar.lab -text " " -anchor w +ttk::sizegrip .statusBar.foo pack .statusBar.lab -side left -padx 2 -expand yes -fill both pack .statusBar.foo -side left -padx 2 pack .statusBar -side bottom -fill x -pady 2 -frame .textFrame +ttk::frame .textFrame scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \ -takefocus 1 -bd 1 pack .s -in .textFrame -side right -fill y @@ -155,16 +153,16 @@ text .t -yscrollcommand {.s set} -wrap word -width 70 -height 30 \ pack .t -in .textFrame -expand y -fill both -padx 1 pack .textFrame -expand yes -fill both -# Create a bunch of tags to use in the text widget, such as those for -# section titles and demo descriptions. Also define the bindings for -# tags. +# Create a bunch of tags to use in the text widget, such as those for section +# titles and demo descriptions. Also define the bindings for tags. .t tag configure title -font titleFont .t tag configure bold -font boldFont -# We put some "space" characters to the left and right of each demo description -# so that the descriptions are highlighted only when the mouse cursor -# is right over them (but not when the cursor is to their left or right) +# We put some "space" characters to the left and right of each demo +# description so that the descriptions are highlighted only when the mouse +# cursor is right over them (but not when the cursor is to their left or +# right). # .t tag configure demospace -lmargin1 1c -lmargin2 1c @@ -216,11 +214,11 @@ set lastLine "" # addFormattedText -- # -# Add formatted text (but not hypertext) to the text widget after -# first passing it through the message catalog to allow for -# localization. Lines starting with @@ are formatting directives -# (begin newline, or change style) and all other lines are literal -# strings to be inserted. Blank lines are ignored. +# Add formatted text (but not hypertext) to the text widget after first +# passing it through the message catalog to allow for localization. +# Lines starting with @@ are formatting directives (begin newline, or +# change style) and all other lines are literal strings to be inserted. +# Blank lines are ignored. # proc addFormattedText {formattedText} { set style normal @@ -249,9 +247,9 @@ proc addFormattedText {formattedText} { # addDemoSection -- # -# Add a new section of demos with a title and a (stride-2) list of -# demo files and their descriptions. Titles and descriptions are -# passed through the message catalog to allow for localization. +# Add a new section of demos with a title and a (stride-2) list of demo +# files and their descriptions. Titles and descriptions are passed +# through the message catalog to allow for localization. # proc addDemoSection {title demos} { .t insert end "\n" {} [mc $title] title " \n " demospace @@ -271,7 +269,7 @@ addFormattedText { This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the - numbered lines below describes a demonstration; you can click on + numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the @@bold @@ -316,6 +314,7 @@ addDemoSection "Text" { bind "Hypertext (tag bindings)" twind "A text widget with embedded windows and other features" search "A search tool built with a text widget" + textpeer "Peering text widgets" } addDemoSection "Canvases" { items "The canvas item types" @@ -366,18 +365,19 @@ focus .s proc addSeeDismiss {w show {vars {}} {extra {}}} { ## See Code / Dismiss buttons - frame $w - frame $w.sep -height 2 -relief sunken -bd 2 + ttk::frame $w + ttk::separator $w.sep + #ttk::frame $w.sep -height 2 -relief sunken grid $w.sep -columnspan 4 -row 0 -sticky ew -pady 2 - button $w.dismiss -text [mc "Dismiss"] \ + ttk::button $w.dismiss -text [mc "Dismiss"] \ -image ::img::delete -compound left \ -command [list destroy [winfo toplevel $w]] - button $w.code -text [mc "See Code"] \ + ttk::button $w.code -text [mc "See Code"] \ -image ::img::view -compound left \ -command [list showCode $show] set buttons [list x $w.code $w.dismiss] if {[llength $vars]} { - button $w.vars -text [mc "See Variables"] \ + ttk::button $w.vars -text [mc "See Variables"] \ -image ::img::view -compound left \ -command [concat [list showVars $w.dialog] $vars] set buttons [linsert $buttons 1 $w.vars] @@ -385,14 +385,14 @@ proc addSeeDismiss {w show {vars {}} {extra {}}} { if {$extra ne ""} { set buttons [linsert $buttons 1 [uplevel 1 $extra]] } - eval grid $buttons -padx 4 -pady 4 + grid {*}$buttons -padx 4 -pady 4 grid columnconfigure $w 0 -weight 1 return $w } # positionWindow -- -# This procedure is invoked by most of the demos to position a -# new demo window. +# This procedure is invoked by most of the demos to position a new demo +# window. # # Arguments: # w - The name of the window to position. @@ -402,8 +402,8 @@ proc positionWindow w { } # showVars -- -# Displays the values of one or more variables in a window, and -# updates the display whenever any of the variables changes. +# Displays the values of one or more variables in a window, and updates the +# display whenever any of the variables changes. # # Arguments: # w - Name of new window to create for display. @@ -414,13 +414,13 @@ proc showVars {w args} { toplevel $w wm title $w [mc "Variable values"] - set f [labelframe $w.title -text [mc "Variable values:"] -font varsFont] + set f [ttk::labelframe $w.title -text [mc "Variable values:"]] foreach var $args { - label $f.n$var -text "$var:" -anchor w - label $f.v$var -textvariable $var -anchor w + ttk::label $f.n$var -text "$var:" -anchor w + ttk::label $f.v$var -textvariable $var -anchor w grid $f.n$var $f.v$var -padx 2 -pady 2 -sticky w } - button $w.ok -width 8 -text [mc "OK"] \ + ttk::button $w.ok -width 8 -text [mc "OK"] \ -command [list destroy $w] -default active bind $w <Return> [list $w.ok invoke] bind $w <Escape> [list $w.ok invoke] @@ -434,8 +434,8 @@ proc showVars {w args} { } # invoke -- -# This procedure is called when the user clicks on a demo description. -# It is responsible for invoking the demonstration. +# This procedure is called when the user clicks on a demo description. It is +# responsible for invoking the demonstration. # # Arguments: # index - The index of the character that the user clicked on. @@ -460,8 +460,8 @@ proc invoke index { # showStatus -- # -# Show the name of the demo program in the status bar. This procedure -# is called when the user moves the cursor over a demo description. +# Show the name of the demo program in the status bar. This procedure is +# called when the user moves the cursor over a demo description. # proc showStatus index { set tags [.t tag names $index] @@ -491,12 +491,12 @@ proc evalShowCode {w} { } # showCode -- -# This procedure creates a toplevel window that displays the code for -# a demonstration and allows it to be edited and reinvoked. +# This procedure creates a toplevel window that displays the code for a +# demonstration and allows it to be edited and reinvoked. # # Arguments: -# w - The name of the demonstration's window, which can be -# used to derive the name of the file containing its code. +# w - The name of the demonstration's window, which can be used to +# derive the name of the file containing its code. proc showCode w { global tk_demoDirectory @@ -522,13 +522,13 @@ proc showCode w { set btns [frame $top.btns] - button $btns.dismiss -text [mc "Dismiss"] \ + ttk::button $btns.dismiss -text [mc "Dismiss"] \ -default active -command [list destroy $top] \ -image ::img::delete -compound left - button $btns.print -text [mc "Print Code"] \ + ttk::button $btns.print -text [mc "Print Code"] \ -command [list printCode $text $file] \ -image ::img::print -compound left - button $btns.rerun -text [mc "Rerun Demo"] \ + ttk::button $btns.rerun -text [mc "Rerun Demo"] \ -command [list evalShowCode $text] \ -image ::img::refresh -compound left @@ -558,8 +558,8 @@ proc showCode w { } # printCode -- -# Prints the source code currently displayed in the See Code dialog. -# Much thanks to Arjen Markus for this. +# Prints the source code currently displayed in the See Code dialog. Much +# thanks to Arjen Markus for this. # # Arguments: # w - Name of text widget containing code to print @@ -618,11 +618,11 @@ proc printCode {w file} { # filename - Name of the file # # Note: -# Taken from the Wiki page by Keith Vetter, "Printing text files -# under Windows" +# Taken from the Wiki page by Keith Vetter, "Printing text files under +# Windows". # Note: -# Do not execute the command in the background: that way we can dispose -# of the file smoothly +# Do not execute the command in the background: that way we can dispose of the +# file smoothly. # proc PrintTextWin32 {filename} { package require registry @@ -652,7 +652,7 @@ proc aboutBox {} { [mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}] [mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] -[mc {Copyright (c) %s} {2001-2003 Donal K. Fellows}]" +[mc {Copyright (c) %s} {2001-2007 Donal K. Fellows}]" } # Local Variables: |