Attachment "classopt.diff" to
ticket [1580120fff]
added by
hobbs
2006-10-19 07:14:24.
? classopt.diff
? pkgIndex.tcl
? modules/chan
? modules/dump
Index: modules/snit/main1.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/snit/main1.tcl,v
retrieving revision 1.6
diff -u -r1.6 main1.tcl
--- modules/snit/main1.tcl 12 Aug 2006 13:22:57 -0000 1.6
+++ modules/snit/main1.tcl 19 Oct 2006 00:11:33 -0000
@@ -2004,9 +2004,7 @@
# Capitalizes the first letter of a string.
proc ::snit::Capitalize {text} {
- set first [string index $text 0]
- set rest [string range $text 1 end]
- return "[string toupper $first]$rest"
+ return [string toupper $text 0]
}
# Converts an arbitrary white-space-delimited string into a list
@@ -2130,22 +2128,28 @@
# Initialize the instance vars to their defaults.
${type}::Snit_instanceVars $selfns
- # NEXT, if this is a normal widget (not a widget adaptor) then
- # create a frame as its hull. We set the frame's -class to
- # the user's widgetclass, or, if none, to the basename of
- # the $type with an initial upper case letter.
+ # NEXT, if this is a normal widget (not a widget adaptor) then create a
+ # frame as its hull. We set the frame's -class to the user's widgetclass,
+ # or, if none, search for -class in the args list, otherwise default to
+ # the basename of the $type with an initial upper case letter.
if {!$Snit_info(isWidgetAdaptor)} {
# FIRST, determine the class name
- if {"" == $Snit_info(widgetclass)} {
- set Snit_info(widgetclass) \
- [::snit::Capitalize [namespace tail $type]]
- }
+ set wclass $Snit_info(widgetclass)
+ if {$Snit_info(widgetclass) eq ""} {
+ set idx [lsearch -exact $args -class]
+ if {$idx >= 0 && ($idx%2 == 0)} {
+ # -class exists and is in the -option position
+ set wclass [lindex $args [expr {$idx+1}]]
+ set args [lreplace $args $idx [expr {$idx+1}]]
+ } else {
+ set wclass [::snit::Capitalize [namespace tail $type]]
+ }
+ }
# NEXT, create the widget
set self $name
package require Tk
- ${type}::installhull using \
- $Snit_info(hulltype) -class $Snit_info(widgetclass)
+ ${type}::installhull using $Snit_info(hulltype) -class $wclass
# NEXT, let's query the option database for our
# widget, now that we know that it exists.
Index: modules/snit/main1_83.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/snit/main1_83.tcl,v
retrieving revision 1.5
diff -u -r1.5 main1_83.tcl
--- modules/snit/main1_83.tcl 12 Aug 2006 13:22:57 -0000 1.5
+++ modules/snit/main1_83.tcl 19 Oct 2006 00:11:33 -0000
@@ -2150,22 +2150,28 @@
# Initialize the instance vars to their defaults.
${type}::Snit_instanceVars $selfns
- # NEXT, if this is a normal widget (not a widget adaptor) then
- # create a frame as its hull. We set the frame's -class to
- # the user's widgetclass, or, if none, to the basename of
- # the $type with an initial upper case letter.
+ # NEXT, if this is a normal widget (not a widget adaptor) then create a
+ # frame as its hull. We set the frame's -class to the user's widgetclass,
+ # or, if none, search for -class in the args list, otherwise default to
+ # the basename of the $type with an initial upper case letter.
if {!$Snit_info(isWidgetAdaptor)} {
# FIRST, determine the class name
- if {"" == $Snit_info(widgetclass)} {
- set Snit_info(widgetclass) \
- [::snit::Capitalize [namespace tail $type]]
- }
+ set wclass $Snit_info(widgetclass)
+ if {$Snit_info(widgetclass) == ""} {
+ set idx [lsearch -exact $args -class]
+ if {$idx >= 0 && ($idx%2 == 0)} {
+ # -class exists and is in the -option position
+ set wclass [lindex $args [expr {$idx+1}]]
+ set args [lreplace $args $idx [expr {$idx+1}]]
+ } else {
+ set wclass [::snit::Capitalize [namespace tail $type]]
+ }
+ }
# NEXT, create the widget
set self $name
package require Tk
- ${type}::installhull using \
- $Snit_info(hulltype) -class $Snit_info(widgetclass)
+ ${type}::installhull using $Snit_info(hulltype) -class $wclass
# NEXT, let's query the option database for our
# widget, now that we know that it exists.
Index: modules/snit/main2.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/snit/main2.tcl,v
retrieving revision 1.9
diff -u -r1.9 main2.tcl
--- modules/snit/main2.tcl 12 Sep 2006 02:04:04 -0000 1.9
+++ modules/snit/main2.tcl 19 Oct 2006 00:11:33 -0000
@@ -1823,9 +1823,7 @@
# Capitalizes the first letter of a string.
proc ::snit::Capitalize {text} {
- set first [string index $text 0]
- set rest [string range $text 1 end]
- return "[string toupper $first]$rest"
+ return [string toupper $text 0]
}
@@ -1938,22 +1936,28 @@
# Initialize the instance vars to their defaults.
${type}::Snit_instanceVars $selfns
- # NEXT, if this is a normal widget (not a widget adaptor) then
- # create a frame as its hull. We set the frame's -class to
- # the user's widgetclass, or, if none, to the basename of
- # the $type with an initial upper case letter.
+ # NEXT, if this is a normal widget (not a widget adaptor) then create a
+ # frame as its hull. We set the frame's -class to the user's widgetclass,
+ # or, if none, search for -class in the args list, otherwise default to
+ # the basename of the $type with an initial upper case letter.
if {!$Snit_info(isWidgetAdaptor)} {
# FIRST, determine the class name
- if {"" == $Snit_info(widgetclass)} {
- set Snit_info(widgetclass) \
- [::snit::Capitalize [namespace tail $type]]
- }
+ set wclass $Snit_info(widgetclass)
+ if {$Snit_info(widgetclass) eq ""} {
+ set idx [lsearch -exact $args -class]
+ if {$idx >= 0 && ($idx%2 == 0)} {
+ # -class exists and is in the -option position
+ set wclass [lindex $args [expr {$idx+1}]]
+ set args [lreplace $args $idx [expr {$idx+1}]]
+ } else {
+ set wclass [::snit::Capitalize [namespace tail $type]]
+ }
+ }
# NEXT, create the widget
set self $name
package require Tk
- ${type}::installhull using \
- $Snit_info(hulltype) -class $Snit_info(widgetclass)
+ ${type}::installhull using $Snit_info(hulltype) -class $wclass
# NEXT, let's query the option database for our
# widget, now that we know that it exists.
Index: modules/snit/snit.man
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/snit/snit.man,v
retrieving revision 1.46
diff -u -r1.46 snit.man
--- modules/snit/snit.man 21 Sep 2006 02:58:46 -0000 1.46
+++ modules/snit/snit.man 19 Oct 2006 00:11:33 -0000
@@ -1914,7 +1914,8 @@
Any widget can be used as the [cmd hulltype] provided that it supports
the [const -class] option for changing its widget class name. See
-the discussion of the [cmd hulltype] command, above.
+the discussion of the [cmd hulltype] command, above. The user may pass
+[const -class] to the widget at instantion.
[para]
