# Some functions needed for the common dialog boxes. Probably need to go
# in a different file.
#
-# SCCS: @(#) comdlg.tcl 1.4 96/09/05 09:07:54
+# RCS: @(#) $Id$
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
set verproc($cmdsw) [lindex $spec 4]
}
- if {([llength $argList]%2) != 0} {
- foreach {cmdsw value} $argList {
- if {![info exists cmd($cmdsw)]} {
- error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
- }
+ if {[llength $argList] & 1} {
+ set cmdsw [lindex $argList end]
+ if {![info exists cmd($cmdsw)]} {
+ error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
- error "value for \"[lindex $argList end]\" missing"
+ error "value for \"$cmdsw\" missing"
}
# 2: set the default values
#
foreach {cmdsw value} $argList {
if {![info exists cmd($cmdsw)]} {
- error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
+ error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
}
set data($cmdsw) $value
}
append errormsg "$separator$cmdsw"
incr i
if {$i == $len} {
- set separator " or "
+ set separator ", or "
} else {
set separator ", "
}
return $errormsg
}
-# This procedure is used to sort strings in a case-insenstive mode.
-#
-proc tclSortNoCase {str1 str2} {
- return [string compare [string toupper $str1] [string toupper $str2]]
-}
-
-
-# Gives an error if the string does not contain a valid integer
-# number
-#
-proc tclVerifyInteger {string} {
- lindex {1 2 3} $string
-}
-
-
#----------------------------------------------------------------------
#
# Focus Group
if {![info exists tkPriv(fg,$t)]} {
set tkPriv(fg,$t) 1
set tkPriv(focus,$t) ""
- bind $t <FocusIn> "tkFocusGroup_In $t %W %d"
- bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
- bind $t <Destroy> "tkFocusGroup_Destroy $t %W"
+ bind $t <FocusIn> [list tkFocusGroup_In $t %W %d]
+ bind $t <FocusOut> [list tkFocusGroup_Out $t %W %d]
+ bind $t <Destroy> [list tkFocusGroup_Destroy $t %W]
}
}
proc tkFocusGroup_Destroy {t w} {
global tkPriv tkFocusIn tkFocusOut
- if {![string compare $t $w]} {
+ if {[string equal $t $w]} {
unset tkPriv(fg,$t)
unset tkPriv(focus,$t)
unset tkFocusOut($name)
}
} else {
- if {[info exists tkPriv(focus,$t)]} {
- if {![string compare $tkPriv(focus,$t) $w]} {
- set tkPriv(focus,$t) ""
- }
+ if {[info exists tkPriv(focus,$t)] && \
+ [string equal $tkPriv(focus,$t) $w]} {
+ set tkPriv(focus,$t) ""
}
catch {
unset tkFocusIn($t,$w)
proc tkFocusGroup_In {t w detail} {
global tkPriv tkFocusIn
+ if {[string compare $detail NotifyNonlinear] && \
+ [string compare $detail NotifyNonlinearVirtual]} {
+ # This is caused by mouse moving out&in of the window *or*
+ # ordinary keypresses some window managers (ie: CDE [Bug: 2960]).
+ return
+ }
if {![info exists tkFocusIn($t,$w)]} {
set tkFocusIn($t,$w) ""
return
if {![info exists tkPriv(focus,$t)]} {
return
}
- if {![string compare $tkPriv(focus,$t) $w]} {
+ if {[string equal $tkPriv(focus,$t) $w]} {
# This is already in focus
#
return
proc tkFocusGroup_Out {t w detail} {
global tkPriv tkFocusOut
- if {[string compare $detail NotifyNonlinear] &&
- [string compare $detail NotifyNonlinearVirtual]} {
+ if {[string compare $detail NotifyNonlinear] && \
+ [string compare $detail NotifyNonlinearVirtual]} {
# This is caused by mouse moving out of the window
return
}
set name "$label ("
set sep ""
foreach ext $fileTypes($label) {
- if {![string compare $ext ""]} {
+ if {[string equal $ext ""]} {
continue
}
regsub {^[.]} $ext "*." ext
return $types
}
+
+