summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-11-05 14:24:16 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-11-05 14:24:16 (GMT)
commitad604020165fcc7705d4e29258e936e25eece01a (patch)
tree64d98c8c7c13ff311bc7179c99808fbb9e2a647c
parent9d5c1ed7b432d032a20a92a500639fd69160ee6a (diff)
downloadtk-ad604020165fcc7705d4e29258e936e25eece01a.zip
tk-ad604020165fcc7705d4e29258e936e25eece01a.tar.gz
tk-ad604020165fcc7705d4e29258e936e25eece01a.tar.bz2
merge updates from HEAD
-rw-r--r--ChangeLog45
-rw-r--r--doc/chooseDirectory.n10
-rw-r--r--doc/getOpenFile.n26
-rw-r--r--doc/menu.n29
-rw-r--r--generic/ttk/ttkDefaultTheme.c4
-rw-r--r--generic/ttk/ttkTreeview.c7
-rw-r--r--library/bgerror.tcl5
-rw-r--r--library/console.tcl30
-rw-r--r--library/demos/mclist.tcl98
-rw-r--r--library/demos/tree.tcl4
-rw-r--r--library/demos/ttknote.tcl8
-rw-r--r--library/demos/widget27
-rw-r--r--library/tkfbox.tcl6
-rw-r--r--macosx/Wish.xcode/project.pbxproj4
-rw-r--r--macosx/Wish.xcodeproj/project.pbxproj4
-rw-r--r--macosx/tkMacOSXEvent.c4
-rw-r--r--macosx/tkMacOSXMenus.c197
17 files changed, 379 insertions, 129 deletions
diff --git a/ChangeLog b/ChangeLog
index b47ab93..6172a40 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,48 @@
+2007-11-04 Joe English <jenglish@users.sourceforge.net>
+
+ * generic/ttk/ttkTreeview.c: Use null "treearea" element for
+ treeview owner-draw area instead of "client", to avoid
+ nameclash with Notebook.client element (this was causing
+ sizing anomalies in XP theme, and introduced extraneous
+ padding).
+ * generic/ttk/ttkDefaultTheme.c: Treeitem.indicator element
+ needs left margin now.
+
+2007-11-04 Daniel Steffen <das@users.sourceforge.net>
+
+ * macosx/tkMacOSXMenus.c: add "Run Widget Demo" menu item to the
+ default Edit menu along with associated carbon event handler enabling
+ the item only if demo files are installed; cleanup handling of "About"
+ and "Source" menu items.
+
+ * library/bgerror.tcl: fix background of detail text on Aqua.
+
+ * library/console.tcl: add accelerators and fix Aqua bindings
+ of the new font size menu items.
+
+ * library/demos/mclist.tcl: Aqua GOOBE.
+ * library/demos/tree.tcl:
+ * library/demos/ttknote.tcl:
+ * library/demos/widget:
+
+ * doc/chooseDirectory.n: remove/correct obsolete Mac OS 9-era
+ * doc/getOpenFile.n: information.
+ * doc/menu.n:
+
+ * macosx/tkMacOSXEvent.c (TkMacOSXProcessCommandEvent): fix boolean arg
+
+ * macosx/Wish.xcodeproj/project.pbxproj: add new demo file.
+ * macosx/Wish.xcode/project.pbxproj:
+
+2007-11-03 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * library/console.tcl: Add menu item and key binding to adjust font.
+
+2007-11-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * library/demos/mclist.tcl: Added a demo of how to do a multi-column
+ sortable listbox.
+
2007-11-02 Donal K. Fellows <donal.k.fellows@manchester.ac.uk>
* library/msgbox.tcl: Made message dialog use Ttk widgets for better
diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n
index 24d22ba..e28515e 100644
--- a/doc/chooseDirectory.n
+++ b/doc/chooseDirectory.n
@@ -2,7 +2,7 @@
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
-'\" RCS: @(#) $Id: chooseDirectory.n,v 1.4.2.3 2007/11/01 16:37:14 dgp Exp $
+'\" RCS: @(#) $Id: chooseDirectory.n,v 1.4.2.4 2007/11/05 14:24:16 dgp Exp $
'\"
.so man.macros
.TH tk_chooseDirectory n 8.3 Tk "Tk Built-In Commands"
@@ -25,10 +25,7 @@ Specifies that the directories in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the directories in the current working directory are displayed. If the
parameter specifies a relative path, the return value will convert the
-relative path to an absolute path. This option may not always work on
-the Macintosh. This is not a bug. Rather, the \fIGeneral Controls\fR
-control panel on the Mac allows the end user to override the
-application default directory.
+relative path to an absolute path.
.TP
\fB\-mustexist\fR \fIboolean\fR
Specifies whether the user may specify non-existent directories. If
@@ -37,7 +34,8 @@ already exist. The default value is \fIfalse\fR.
.TP
\fB\-parent\fR \fIwindow\fR
Makes \fIwindow\fR the logical parent of the dialog. The dialog
-is displayed on top of its parent window.
+is displayed on top of its parent window. On Mac OS X, this
+turns the file dialog into a sheet attached to the parent window.
.TP
\fB\-title\fR \fItitleString\fR
Specifies a string to display as the title of the dialog box. If this
diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n
index 8faa713..8a637bb 100644
--- a/doc/getOpenFile.n
+++ b/doc/getOpenFile.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: getOpenFile.n,v 1.15.2.3 2007/11/01 16:37:14 dgp Exp $
+'\" RCS: @(#) $Id: getOpenFile.n,v 1.15.2.4 2007/11/05 14:24:16 dgp Exp $
'\"
.so man.macros
.TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
@@ -41,7 +41,7 @@ arguments to these two commands:
Specifies a string that will be appended to the filename if the user
enters a filename without an extension. The default value is the empty
string, which means no extension will be appended to the filename in
-any case. This option is ignored on the Macintosh platform, which
+any case. This option is ignored on Mac OS X, which
does not require extensions to filenames,
and the UNIX implementation guesses reasonable values for this from
the \fB\-filetypes\fR option when this is not supplied.
@@ -61,28 +61,22 @@ Specifies that the files in \fIdirectory\fR should be displayed
when the dialog pops up. If this parameter is not specified, then
the files in the current working directory are displayed. If the
parameter specifies a relative path, the return value will convert the
-relative path to an absolute path. This option may not always work on
-the Macintosh. This is not a bug. Rather, the \fIGeneral Controls\fR
-control panel on the Mac allows the end user to override the
-application default directory.
+relative path to an absolute path.
.TP
\fB\-initialfile\fR \fIfilename\fR
-Specifies a filename to be displayed in the dialog when it pops up. This
-option is ignored on the Macintosh platform.
+Specifies a filename to be displayed in the dialog when it pops up.
.TP
\fB\-message\fR \fIstring\fR
Specifies a message to include in the client area of the dialog.
-This is only available on the Macintosh, and only when Navigation
-Services are installed.
+This is only available on Mac OS X.
.TP
\fB\-multiple\fR \fIboolean\fR
Allows the user to choose multiple files from the Open dialog.
-On the Macintosh, this is only available when Navigation Services are
-installed.
.TP
\fB\-parent\fR \fIwindow\fR
Makes \fIwindow\fR the logical parent of the file dialog. The file
-dialog is displayed on top of its parent window.
+dialog is displayed on top of its parent window. On Mac OS X, this
+turns the file dialog into a sheet attached to the parent window.
.TP
\fB\-title\fR \fItitleString\fR
Specifies a string to display as the title of the dialog box. If this
@@ -121,8 +115,8 @@ they refer to the same file type and share the same entry in the
listbox. When the user selects an entry in the listbox, all the files
that match at least one of the file patterns corresponding
to that entry are listed. Usually, each file pattern corresponds to a
-distinct type of file. The use of more than one file patterns for one
-type of file is necessary on the Macintosh platform only.
+distinct type of file. The use of more than one file pattern for one
+type of file is only necessary on the Macintosh platform.
.PP
On the Macintosh platform, a file matches a file pattern if its
name matches at least one of the \fIextension\fR(s) AND it
@@ -141,7 +135,7 @@ the file pattern. The \fImacType\fRs are ignored.
.SH "SPECIFYING EXTENSIONS"
.PP
On the Unix and Macintosh platforms, extensions are matched using
-glob-style pattern matching. On the Windows platforms, extensions are
+glob-style pattern matching. On the Windows platform, extensions are
matched by the underlying operating system. The types of possible
extensions are:
.IP (1)
diff --git a/doc/menu.n b/doc/menu.n
index d151ede..2b43bf5 100644
--- a/doc/menu.n
+++ b/doc/menu.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: menu.n,v 1.15.2.2 2007/11/01 16:37:15 dgp Exp $
+'\" RCS: @(#) $Id: menu.n,v 1.15.2.3 2007/11/05 14:24:16 dgp Exp $
'\"
.so man.macros
.TH menu n 4.1 Tk "Tk Built-In Commands"
@@ -231,7 +231,7 @@ to system restrictions.
.SS "SPECIAL MENUS IN MENUBARS"
.PP
Certain menus in a menubar will be treated specially. On the Macintosh,
-access to the special Apple and Help menus is provided. On Windows,
+access to the special Application and Help menus is provided. On Windows,
access to the Windows System menu in each window is provided. On X Windows,
a special right-justified help menu is provided. In all cases, these
menus must be created with the command name of the menubar menu concatenated
@@ -240,25 +240,16 @@ the special menus would be .menubar.apple and .menubar.help; on Windows,
the special menu would be .menubar.system; on X Windows, the help
menu would be .menubar.help.
.PP
-When Tk sees an Apple menu on the Macintosh, that menu's contents make
-up the first items of the Apple menu on the screen whenever the window
-containing the menubar is in front. The menu is the
-first one that the user sees and has a title which is an Apple logo.
+When Tk sees a .menubar.apple menu on the Macintosh, that menu's contents
+make up the first items of the Application menu whenever the window
+containing the menubar is in front.
After all of the Tk-defined items, the menu will have a separator,
-followed by all of the items in the user's Apple Menu Items folder.
-Since the System uses a different menu definition procedure for
-the Apple menu than Tk uses for its menus, and the system APIs do
-not fully support everything Tk tries to do, the menu item will only
-have its text displayed. No font attributes, images, bitmaps, or colors
-will be displayed. In addition, a menu with a tearoff item will have
-the tearoff item displayed as
-.QW (TearOff) .
+followed by all standard Application menu items.
.PP
-When Tk see a Help menu on the Macintosh, the menu's contents are
-appended to the standard help menu on the right of the user's menubar
-whenever the user's menubar is in front. The first items in the menu
-are provided by Apple. Similar to the Apple Menu, customization in this
-menu is limited to what the system provides.
+When Tk sees a Help menu on the Macintosh, the menu's contents are
+appended to the standard Help menu on the right of the user's menubar
+whenever the window's menubar is in front. The first items in the menu
+are provided by Mac OS X.
.PP
When Tk sees a System menu on Windows, its items are appended to the
system menu that the menubar is attached to. This menu has an icon
diff --git a/generic/ttk/ttkDefaultTheme.c b/generic/ttk/ttkDefaultTheme.c
index 47f5582..109f646 100644
--- a/generic/ttk/ttkDefaultTheme.c
+++ b/generic/ttk/ttkDefaultTheme.c
@@ -1,4 +1,4 @@
-/* $Id: ttkDefaultTheme.c,v 1.7.2.1 2007/10/27 04:23:15 dgp Exp $
+/* $Id: ttkDefaultTheme.c,v 1.7.2.2 2007/11/05 14:24:16 dgp Exp $
*
* Copyright (c) 2003, Joe English
*
@@ -1048,7 +1048,7 @@ static Ttk_ElementOptionSpec TreeitemIndicatorOptions[] =
{ "-diameter", TK_OPTION_PIXELS,
Tk_Offset(TreeitemIndicator,diameterObj), "9" },
{ "-indicatormargins", TK_OPTION_STRING,
- Tk_Offset(TreeitemIndicator,marginObj), "0 2 4 2" },
+ Tk_Offset(TreeitemIndicator,marginObj), "2 2 4 2" },
{NULL}
};
diff --git a/generic/ttk/ttkTreeview.c b/generic/ttk/ttkTreeview.c
index 4e72781..531dca5 100644
--- a/generic/ttk/ttkTreeview.c
+++ b/generic/ttk/ttkTreeview.c
@@ -1,4 +1,4 @@
-/* $Id: ttkTreeview.c,v 1.16.2.2 2007/10/27 04:23:16 dgp Exp $
+/* $Id: ttkTreeview.c,v 1.16.2.3 2007/11/05 14:24:17 dgp Exp $
* Copyright (c) 2004, Joe English
*
* ttk::treeview widget implementation.
@@ -1470,7 +1470,7 @@ static Ttk_Layout TreeviewGetLayout(
static void TreeviewDoLayout(void *clientData)
{
Treeview *tv = clientData;
- Ttk_LayoutNode *clientNode = Ttk_LayoutFindNode(tv->core.layout, "client");
+ Ttk_LayoutNode *clientNode = Ttk_LayoutFindNode(tv->core.layout,"treearea");
int visibleRows;
/* ASSERT: SLACKINVARIANT */
@@ -3044,7 +3044,7 @@ static WidgetSpec TreeviewWidgetSpec =
TTK_BEGIN_LAYOUT(TreeviewLayout)
TTK_GROUP("Treeview.field", TTK_FILL_BOTH|TTK_BORDER,
TTK_GROUP("Treeview.padding", TTK_FILL_BOTH,
- TTK_NODE("Treeview.client", TTK_FILL_BOTH)))
+ TTK_NODE("Treeview.treearea", TTK_FILL_BOTH)))
TTK_END_LAYOUT
TTK_BEGIN_LAYOUT(ItemLayout)
@@ -3197,6 +3197,7 @@ void TtkTreeview_Init(Tcl_Interp *interp)
&TreeitemIndicatorElementSpec, 0);
Ttk_RegisterElement(interp, theme, "Treeitem.row", &RowElementSpec, 0);
Ttk_RegisterElement(interp, theme, "Treeheading.cell", &RowElementSpec, 0);
+ Ttk_RegisterElement(interp, theme, "treearea", &ttkNullElementSpec, 0);
Ttk_RegisterLayout(theme, TreeviewWidgetSpec.className, TreeviewLayout);
Ttk_RegisterLayout(theme, "Item", ItemLayout);
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 745974b..cd79460 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -9,8 +9,8 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 2007 by ActiveState Software Inc.
#
-# RCS: @(#) $Id: bgerror.tcl,v 1.33.2.2 2007/11/01 16:37:20 dgp Exp $
-# $Id: bgerror.tcl,v 1.33.2.2 2007/11/01 16:37:20 dgp Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.33.2.3 2007/11/05 14:24:18 dgp Exp $
+# $Id: bgerror.tcl,v 1.33.2.3 2007/11/05 14:24:18 dgp Exp $
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
@@ -22,6 +22,7 @@ namespace eval ::tk::dialog::error {
if {[tk windowingsystem] eq "aqua"} {
option add *ErrorDialog*background systemAlertBackgroundActive \
widgetDefault
+ option add *ErrorDialog*info.text.background white widgetDefault
option add *ErrorDialog*Button.highlightBackground \
systemAlertBackgroundActive widgetDefault
}
diff --git a/library/console.tcl b/library/console.tcl
index 994a0b4..b819943 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# RCS: @(#) $Id: console.tcl,v 1.31.2.2 2007/10/24 12:59:33 dgp Exp $
+# RCS: @(#) $Id: console.tcl,v 1.31.2.3 2007/11/05 14:24:18 dgp Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
@@ -96,13 +96,19 @@ proc ::tk::ConsoleInit {} {
-command tk::ConsoleAbout
}
+ AmpMenuArgs .menubar.edit add separator
+ AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \
+ -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
+ AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
+ -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>}
+
. configure -menu .menubar
# See if we can find a better font than the TkFixedFont
font create TkConsoleFont {*}[font configure TkFixedFont]
set families [font families]
switch -exact -- [tk windowingsystem] {
- aqua { set preferred {Monaco 9} }
+ aqua { set preferred {Monaco 10} }
win32 { set preferred {ProFontWindows 8 Consolas 8} }
default { set preferred {} }
}
@@ -375,11 +381,21 @@ proc ::tk::ConsoleBind {w} {
<<Console_Transpose>> <Control-Key-t>
<<Console_ClearLine>> <Control-Key-u>
<<Console_SaveCommand>> <Control-Key-z>
+ <<Console_FontSizeIncr>> <Control-Key-plus>
+ <<Console_FontSizeDecr>> <Control-Key-minus>
} {
event add $ev $key
bind Console $key {}
}
-
+ if {[tk windowingsystem] eq "aqua"} {
+ foreach {ev key} {
+ <<Console_FontSizeIncr>> <Command-Key-plus>
+ <<Console_FontSizeDecr>> <Command-Key-minus>
+ } {
+ event add $ev $key
+ bind Console $key {}
+ }
+ }
bind Console <<Console_Expand>> {
if {[%W compare insert > promptEnd]} {
::tk::console::Expand %W
@@ -535,6 +551,14 @@ proc ::tk::ConsoleBind {w} {
}
}
}
+ bind Console <<Console_FontSizeIncr>> {
+ set size [font configure TkConsoleFont -size]
+ font configure TkConsoleFont -size [incr size]
+ }
+ bind Console <<Console_FontSizeDecr>> {
+ set size [font configure TkConsoleFont -size]
+ font configure TkConsoleFont -size [incr size -1]
+ }
##
## Bindings for doing special things based on certain keys
diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl
new file mode 100644
index 0000000..04447a2
--- /dev/null
+++ b/library/demos/mclist.tcl
@@ -0,0 +1,98 @@
+# mclist.tcl --
+#
+# This demonstration script creates a toplevel window containing a Ttk
+# tree widget configured as a multi-column listbox.
+#
+# RCS: @(#) $Id: mclist.tcl,v 1.2.2.2 2007/11/05 14:24:18 dgp Exp $
+
+if {![info exists widgetDemo]} {
+ error "This script should be run from the \"widget\" demo."
+}
+
+package require Tk
+package require Ttk
+
+set w .mclist
+catch {destroy $w}
+toplevel $w
+wm title $w "Multi-Column List"
+wm iconname $w "mclist"
+positionWindow $w
+
+## Explanatory text
+ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which can be configured to display multiple columns of informational data without displaying the tree itself. This is a simple way to build a listbox that has multiple columns. Clicking on the heading for a column will sort the data by that column. You can also change the width of the columns by dragging the boundary between them."
+pack $w.msg -fill x
+
+## See Code / Dismiss
+pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x
+
+ttk::frame $w.container
+ttk::treeview $w.tree -columns {country capital currency} -show headings \
+ -yscroll "$w.vsb set" -xscroll "$w.hsb set"
+if {[tk windowingsystem] ne "aqua"} {
+ ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview"
+ ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
+} else {
+ scrollbar $w.vsb -orient vertical -command "$w.tree yview"
+ scrollbar $w.hsb -orient horizontal -command "$w.tree xview"
+}
+pack $w.container -fill both -expand 1
+grid $w.tree $w.vsb -in $w.container -sticky nsew
+grid $w.hsb -in $w.container -sticky nsew
+grid column $w.container 0 -weight 1
+grid row $w.container 0 -weight 1
+
+## The data we're going to insert
+set data {
+ Argentina {Buenos Aires} ARS
+ Australia Canberra AUD
+ Brazil Brazilia BRL
+ Canada Ottawa CAD
+ China Beijing CNY
+ France Paris EUR
+ Germany Berlin EUR
+ India {New Delhi} INR
+ Italy Rome EUR
+ Japan Tokyo JPY
+ Mexico {Mexico City} MXN
+ Russia Moscow RUB
+ {South Africa} Pretoria ZAR
+ {United Kingdom} London GBP
+ {United States} {Washington, D.C.} USD
+}
+
+## Code to insert the data nicely
+set font [ttk::style lookup [$w.tree cget -style] -font]
+foreach col {country capital currency} name {Country Capital Currency} {
+ $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name
+ $w.tree column $col -width [font measure $font $name]
+}
+foreach {country capital currency} $data {
+ $w.tree insert {} end -values [list $country $capital $currency]
+ foreach col {country capital currency} {
+ set len [font measure $font "[set $col] "]
+ if {[$w.tree column $col -width] < $len} {
+ $w.tree column $col -width $len
+ }
+ }
+}
+
+## Code to do the sorting of the tree contents when clicked on
+proc SortBy {tree col direction} {
+ # Build something we can sort
+ set data {}
+ foreach row [$tree children {}] {
+ lappend data [list [$tree set $row $col] $row]
+ }
+
+ set dir [expr {$direction ? "-decreasing" : "-increasing"}]
+ set r -1
+
+ # Now reshuffle the rows into the sorted order
+ foreach info [lsort -dictionary -index 0 $dir $data] {
+ $tree move [lindex $info 1] {} [incr r]
+ }
+
+ # Switch the heading so that it will sort in the opposite direction
+ $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]]
+}
diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl
index 0946150..e8608b3 100644
--- a/library/demos/tree.tcl
+++ b/library/demos/tree.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing a Ttk
# tree widget.
#
-# RCS: @(#) $Id: tree.tcl,v 1.2.2.2 2007/10/24 12:59:33 dgp Exp $
+# RCS: @(#) $Id: tree.tcl,v 1.2.2.3 2007/11/05 14:24:18 dgp Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -20,7 +20,7 @@ wm iconname $w "tree"
positionWindow $w
## Explanatory text
-ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them."
+ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {10 2 10 6} -text "Ttk is the new Tk themed widget set. One of the widgets it includes is a tree widget, which allows the user to browse a hierarchical data-set such as a filesystem. The tree widget not only allows for the tree part itself, but it also supports an arbitrary number of additional columns which can show additional data (in this case, the size of the files found in your filesystem). You can also change the width of the columns by dragging the boundary between them."
pack $w.msg -fill x
## See Code / Dismiss
diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl
index d4e5511..d78166f 100644
--- a/library/demos/ttknote.tcl
+++ b/library/demos/ttknote.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing a Ttk
# notebook widget.
#
-# RCS: @(#) $Id: ttknote.tcl,v 1.2.2.3 2007/11/02 14:51:40 dgp Exp $
+# RCS: @(#) $Id: ttknote.tcl,v 1.2.2.4 2007/11/05 14:24:18 dgp Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -55,6 +55,10 @@ ttk::frame $w.note.editor
$w.note add $w.note.editor -text "Text Editor" -underline 0
text $w.note.editor.t -width 40 -height 10 -wrap char \
-yscroll "$w.note.editor.s set"
-ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview"
+if {[tk windowingsystem] ne "aqua"} {
+ ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview"
+} else {
+ scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview"
+}
pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2
pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0}
diff --git a/library/demos/widget b/library/demos/widget
index 12c4b8a..e64b061 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -10,7 +10,7 @@ exec wish "$0" "$@"
# separate ".tcl" files is this directory, which are sourced by this script as
# needed.
#
-# RCS: @(#) $Id: widget,v 1.29.2.6 2007/11/01 16:37:23 dgp Exp $
+# RCS: @(#) $Id: widget,v 1.29.2.7 2007/11/05 14:24:18 dgp Exp $
package require Tcl 8.5
package require Tk 8.5
@@ -103,19 +103,14 @@ image create photo ::img::new -format GIF -data [mc {
menu .menuBar -tearoff 0
-# On the Mac use the special .apple menu for the about item
-if {[tk windowingsystem] eq "aqua"} {
- .menuBar add cascade -menu .menuBar.apple
- menu .menuBar.apple -tearoff 0
- .menuBar.apple add command -label [mc "About..."] -command {aboutBox}
-} else {
+if {[tk windowingsystem] ne "aqua"} {
# This is a tk-internal procedure to make i18n easier
::tk::AmpMenuArgs .menuBar add cascade -label [mc "&File"] \
-menu .menuBar.file
menu .menuBar.file -tearoff 0
::tk::AmpMenuArgs .menuBar.file add command -label [mc "&About..."] \
- -command {aboutBox} -accelerator [mc "<F1>"]
- bind . <F1> {aboutBox}
+ -command {tkAboutDialog} -accelerator [mc "<F1>"]
+ bind . <F1> {tkAboutDialog}
.menuBar.file add sep
if {[string match win* [tk windowingsystem]]} {
# Windows doesn't usually have a Meta key
@@ -145,8 +140,12 @@ if {[tk windowingsystem] ne "aqua"} {
pack .statusBar -side bottom -fill x -pady 2
set textheight 30
-catch {set textheight [expr {([winfo screenheight .] - 100) /
- [font metrics mainFont -displayof . -linespace]}]}
+catch {
+ set textheight [expr {
+ ([winfo screenheight .] - 200) /
+ [font metrics mainFont -displayof . -linespace]
+ }]
+}
ttk::frame .textFrame
scrollbar .s -orient vertical -command {.t yview} -takefocus 1
@@ -329,6 +328,8 @@ addFormattedText {
@@demo colors Colors: change the color scheme for the application
@@demo sayings A collection of famous and infamous sayings
@@new
+ @@demo mclist A multi-column list of countries
+ @@new
@@demo tree A directory browser tree
@@subtitle Entries, Spin-boxes and Combo-boxes
@@ -712,11 +713,11 @@ proc PrintTextWin32 {filename} {
eval exec $command
}
-# aboutBox --
+# tkAboutDialog --
#
# Pops up a message box with an "about" message
#
-proc aboutBox {} {
+proc tkAboutDialog {} {
tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \
-message [mc "Tk widget demonstration application"] -detail \
"[mc {Copyright (c) %s} {1996-1997 Sun Microsystems, Inc.}]
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index d87cd2c..92d45b2 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.59.2.3 2007/11/02 14:51:39 dgp Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.59.2.4 2007/11/05 14:24:18 dgp Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -1156,7 +1156,7 @@ static char updir_bits[] = {
# grid the widgets in f2
#
- grid $f2.lab $f2.ent $data(okBtn) -padx 4 -sticky ew
+ grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew
grid configure $f2.ent -padx 2
if {$class eq "TkFDialog"} {
grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \
@@ -1171,7 +1171,7 @@ static char updir_bits[] = {
# Pack all the frames together. We are done with widget construction.
#
pack $f1 -side top -fill x -pady 4
- pack $f2 -side bottom -fill x
+ pack $f2 -side bottom -pady 4 -fill x
pack $data(icons) -expand yes -fill both -padx 4 -pady 1
# Set up the event handlers that are common to Directory and File Dialogs
diff --git a/macosx/Wish.xcode/project.pbxproj b/macosx/Wish.xcode/project.pbxproj
index 3c1b3a4..692a125 100644
--- a/macosx/Wish.xcode/project.pbxproj
+++ b/macosx/Wish.xcode/project.pbxproj
@@ -2036,6 +2036,7 @@
F9A3082D08F2D4AB00BAE1AB /* Tk.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tk.framework; sourceTree = BUILT_PRODUCTS_DIR; };
F9A3084B08F2D4CE00BAE1AB /* Wish.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Wish.app; sourceTree = BUILT_PRODUCTS_DIR; };
F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mclist.tcl; sourceTree = "<group>"; };
F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
@@ -2091,7 +2092,7 @@
F966C06F08F281DC005CB29B /* Frameworks */,
1AB674ADFE9D54B511CA2CBB /* Products */,
);
- comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.13.2.5 2007/10/24 12:59:35 dgp Exp $\n";
+ comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.13.2.6 2007/11/05 14:24:19 dgp Exp $\n";
name = Wish;
path = .;
sourceTree = SOURCE_ROOT;
@@ -2487,6 +2488,7 @@
F966BB4308F27A3A005CB29B /* ixset */,
F966BB4408F27A3A005CB29B /* label.tcl */,
F966BB4508F27A3A005CB29B /* labelframe.tcl */,
+ F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */,
F966BB4608F27A3A005CB29B /* menu.tcl */,
F966BB4708F27A3A005CB29B /* menubu.tcl */,
F966BB4808F27A3A005CB29B /* msgbox.tcl */,
diff --git a/macosx/Wish.xcodeproj/project.pbxproj b/macosx/Wish.xcodeproj/project.pbxproj
index f0a7558..75fe426 100644
--- a/macosx/Wish.xcodeproj/project.pbxproj
+++ b/macosx/Wish.xcodeproj/project.pbxproj
@@ -2038,6 +2038,7 @@
F9A3082D08F2D4AB00BAE1AB /* Tk.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tk.framework; sourceTree = BUILT_PRODUCTS_DIR; };
F9A3084B08F2D4CE00BAE1AB /* Wish.app */ = {isa = PBXFileReference; explicitFileType = wrapper.application; includeInIndex = 0; path = Wish.app; sourceTree = BUILT_PRODUCTS_DIR; };
F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
+ F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mclist.tcl; sourceTree = "<group>"; };
F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
@@ -2094,7 +2095,7 @@
F966C06F08F281DC005CB29B /* Frameworks */,
1AB674ADFE9D54B511CA2CBB /* Products */,
);
- comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.9 2007/10/24 12:59:36 dgp Exp $\n";
+ comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.10 2007/11/05 14:24:19 dgp Exp $\n";
name = Wish;
path = .;
sourceTree = SOURCE_ROOT;
@@ -2490,6 +2491,7 @@
F966BB4308F27A3A005CB29B /* ixset */,
F966BB4408F27A3A005CB29B /* label.tcl */,
F966BB4508F27A3A005CB29B /* labelframe.tcl */,
+ F9D1360A0CDC252C00DBE0B5 /* mclist.tcl */,
F966BB4608F27A3A005CB29B /* menu.tcl */,
F966BB4708F27A3A005CB29B /* menubu.tcl */,
F966BB4808F27A3A005CB29B /* msgbox.tcl */,
diff --git a/macosx/tkMacOSXEvent.c b/macosx/tkMacOSXEvent.c
index b4e1b31..940c48f 100644
--- a/macosx/tkMacOSXEvent.c
+++ b/macosx/tkMacOSXEvent.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacOSXEvent.c,v 1.16.2.4 2007/07/01 17:31:32 dgp Exp $
+ * RCS: @(#) $Id: tkMacOSXEvent.c,v 1.16.2.5 2007/11/05 14:24:18 dgp Exp $
*/
#include "tkMacOSXPrivate.h"
@@ -243,7 +243,7 @@ TkMacOSXProcessCommandEvent(
(menuContext & kMenuContextMenuBarTracking)) {
TkMacOSXHandleMenuSelect(GetMenuID(command.menu.menuRef),
command.menu.menuItemIndex,
- GetCurrentEventKeyModifiers() & optionKey);
+ (GetCurrentEventKeyModifiers() & optionKey) != 0);
return 1;
}
} else {
diff --git a/macosx/tkMacOSXMenus.c b/macosx/tkMacOSXMenus.c
index 5afc016..f307117 100644
--- a/macosx/tkMacOSXMenus.c
+++ b/macosx/tkMacOSXMenus.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacOSXMenus.c,v 1.16.2.2 2007/07/01 17:31:37 dgp Exp $
+ * RCS: @(#) $Id: tkMacOSXMenus.c,v 1.16.2.3 2007/11/05 14:24:19 dgp Exp $
*/
#include "tkMacOSXPrivate.h"
@@ -22,7 +22,8 @@
#define kEditMenu 3
#define kSourceItem 1
-#define kCloseItem 2
+#define kDemoItem 2
+#define kCloseItem 3
#define EDIT_CUT 1
#define EDIT_COPY 2
@@ -33,15 +34,53 @@ MenuRef tkAppleMenu;
MenuRef tkFileMenu;
MenuRef tkEditMenu;
-static Tcl_Interp * gInterp; /* Interpreter for this application. */
+static Tcl_Interp * gInterp = NULL; /* Standard menu interpreter. */
+static EventHandlerRef menuEventHandlerRef = NULL;
static void GenerateEditEvent(int flag);
-static void SourceDialog(void);
+static Tcl_Obj* GetWidgetDemoPath(Tcl_Interp *interp);
+static OSStatus MenuEventHandlerProc(EventHandlerCallRef callRef,
+ EventRef event, void *userData);
+
/*
*----------------------------------------------------------------------
*
+ * GetWidgetDemoPath --
+ *
+ * Get path to the widget demo.
+ *
+ * Results:
+ * pathObj with ref count 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+GetWidgetDemoPath(
+ Tcl_Interp *interp)
+{
+ Tcl_Obj *libpath , *result = NULL;
+
+ libpath = Tcl_GetVar2Ex(gInterp, "tk_library", NULL, TCL_GLOBAL_ONLY);
+ if (libpath) {
+ Tcl_Obj *demo[2] = { Tcl_NewStringObj("demos", 5),
+ Tcl_NewStringObj("widget", 6) };
+
+ Tcl_IncrRefCount(libpath);
+ result = Tcl_FSJoinToPath(libpath, 2, demo);
+ Tcl_DecrRefCount(libpath);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkMacOSXHandleMenuSelect --
*
* Handles events that occur in the Menu bar.
@@ -81,8 +120,11 @@ TkMacOSXHandleMenuSelect(
"tkAboutDialog", &dummy) == 0) {
TkAboutDlg();
} else {
- Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
- TCL_EVAL_GLOBAL);
+ if (Tcl_EvalEx(gInterp, "tkAboutDialog", -1,
+ TCL_EVAL_GLOBAL) != TCL_OK) {
+ Tcl_BackgroundError(gInterp);
+ }
+ Tcl_ResetResult(gInterp);
}
break;
}
@@ -91,11 +133,41 @@ TkMacOSXHandleMenuSelect(
case kFileMenu:
switch (theItem) {
case kSourceItem:
- /*
- * TODO: source script
- */
+ if (gInterp) {
+ if(Tcl_EvalEx(gInterp, "tk_getOpenFile -filetypes {"
+ "{{TCL Scripts} {.tcl} TEXT} "
+ "{{Text Files} {} TEXT}}", -1, TCL_EVAL_GLOBAL)
+ == TCL_OK) {
+ Tcl_Obj *path = Tcl_GetObjResult(gInterp);
+ int len;
+
+ Tcl_GetStringFromObj(path, &len);
+ if (len) {
+ Tcl_IncrRefCount(path);
+ if (Tcl_FSEvalFile(gInterp, path)
+ == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+ Tcl_DecrRefCount(path);
+ }
+ }
+ Tcl_ResetResult(gInterp);
+ }
+ break;
+ case kDemoItem:
+ if (gInterp) {
+ Tcl_Obj *path = GetWidgetDemoPath(gInterp);
- SourceDialog();
+ if (path) {
+ Tcl_IncrRefCount(path);
+ if (Tcl_FSEvalFile(gInterp, path)
+ == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+ Tcl_DecrRefCount(path);
+ Tcl_ResetResult(gInterp);
+ }
+ }
break;
case kCloseItem:
/* Send close event */
@@ -127,6 +199,53 @@ TkMacOSXHandleMenuSelect(
/*
*----------------------------------------------------------------------
*
+ * MenuEventHandlerProc --
+ *
+ * One-time handler of kEventMenuEnableItems for the edit menu.
+ *
+ * Results:
+ * OS status code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSStatus
+MenuEventHandlerProc(
+ EventHandlerCallRef callRef,
+ EventRef event,
+ void *userData)
+{
+ OSStatus result = eventNotHandledErr, err;
+ int menuContext;
+
+ err = ChkErr(GetEventParameter, event, kEventParamMenuContext, typeUInt32,
+ NULL, sizeof(menuContext), NULL, &menuContext);
+ if (err == noErr && (menuContext & kMenuContextMenuBarTracking)) {
+ if (gInterp) {
+ Tcl_Obj *path = GetWidgetDemoPath(gInterp);
+
+ if (path) {
+ Tcl_IncrRefCount(path);
+ if (Tcl_FSAccess(path, R_OK) == 0) {
+ EnableMenuItem(tkFileMenu, kDemoItem);
+ }
+ Tcl_DecrRefCount(path);
+ }
+ }
+ ChkErr(RemoveEventHandler, menuEventHandlerRef);
+ menuEventHandlerRef = NULL;
+ result = noErr;
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TkMacOSXInitMenus --
*
* This procedure initializes the Macintosh menu bar.
@@ -145,8 +264,12 @@ TkMacOSXInitMenus(
Tcl_Interp *interp)
{
OSStatus err;
- gInterp = interp;
+ EventHandlerUPP menuEventHandlerUPP;
+ const EventTypeSpec menuEventTypes[] = {
+ {kEventClassMenu, kEventMenuEnableItems},
+ };
+ gInterp = interp;
if (TkMacOSXUseMenuID(kAppleMenu) != TCL_OK) {
Tcl_Panic("Menu ID %d is already in use!", kAppleMenu);
}
@@ -170,8 +293,15 @@ TkMacOSXInitMenus(
}
SetMenuTitle(tkFileMenu, "\pFile");
InsertMenu(tkFileMenu, 0);
- AppendMenu(tkFileMenu, "\pSource\xc9");
- AppendMenu(tkFileMenu, "\pClose/W");
+ InsertMenuItem(tkFileMenu, "\pSource\xc9", kSourceItem - 1);
+ InsertMenuItem(tkFileMenu, "\pRun Widget Demo", kDemoItem - 1);
+ InsertMenuItem(tkFileMenu, "\pClose/W", kCloseItem - 1);
+ DisableMenuItem(tkFileMenu, kDemoItem);
+ menuEventHandlerUPP = NewEventHandlerUPP(MenuEventHandlerProc);
+ ChkErr(InstallEventHandler, GetMenuEventTarget(tkFileMenu),
+ menuEventHandlerUPP, GetEventTypeCount(menuEventTypes),
+ menuEventTypes, NULL, &menuEventHandlerRef);
+ DisposeEventHandlerUPP(menuEventHandlerUPP);
if (TkMacOSXUseMenuID(kEditMenu) != TCL_OK) {
Tcl_Panic("Menu ID %d is already in use!", kEditMenu);
@@ -270,44 +400,3 @@ GenerateEditEvent(
}
Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL);
}
-
-/*
- *----------------------------------------------------------------------
- *
- * SourceDialog --
- *
- * Presents a dialog to the user for selecting a Tcl file. The
- * selected file will be sourced into the main interpreter.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-SourceDialog(void)
-{
- int result;
- const char *path;
- const char *openCmd = "tk_getOpenFile -filetypes {\
- {{TCL Scripts} {.tcl} TEXT} {{Text Files} {} TEXT}}";
-
- if (gInterp == NULL) {
- return;
- }
- if (Tcl_EvalEx(gInterp, openCmd, -1, TCL_EVAL_GLOBAL) != TCL_OK) {
- return;
- }
- path = Tcl_GetStringResult(gInterp);
- if (strlen(path) == 0) {
- return;
- }
- result = Tcl_EvalFile(gInterp, path);
- if (result == TCL_ERROR) {
- Tcl_BackgroundError(gInterp);
- }
-}