OSDN Git Service

touched all tk files to ease next import
[pf3gnuchains/pf3gnuchains4x.git] / tk / library / comdlg.tcl
index 30e4c81..929f741 100644 (file)
@@ -3,7 +3,7 @@
 #      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.
 #
@@ -52,13 +52,12 @@ proc tclParseConfigSpec {w specs flags argList} {
        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
@@ -71,7 +70,7 @@ proc tclParseConfigSpec {w specs flags argList} {
     #
     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
     }
@@ -90,7 +89,7 @@ proc tclListValidFlags {v} {
        append errormsg "$separator$cmdsw"
        incr i
        if {$i == $len} {
-           set separator " or "
+           set separator ", or "
        } else {
            set separator ", "
        }
@@ -98,21 +97,6 @@ proc tclListValidFlags {v} {
     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
@@ -143,9 +127,9 @@ proc tkFocusGroup_Create {t} {
     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]
     }
 }
 
@@ -185,7 +169,7 @@ proc tkFocusGroup_BindOut {t w cmd} {
 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) 
 
@@ -196,10 +180,9 @@ proc tkFocusGroup_Destroy {t w} {
            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)
@@ -218,6 +201,12 @@ proc tkFocusGroup_Destroy {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
@@ -225,7 +214,7 @@ proc tkFocusGroup_In {t w detail} {
     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
@@ -245,8 +234,8 @@ proc tkFocusGroup_In {t w detail} {
 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
     }
@@ -287,7 +276,7 @@ proc tkFDGetFileTypes {string} {
        set name "$label ("
        set sep ""
        foreach ext $fileTypes($label) {
-           if {![string compare $ext ""]} {
+           if {[string equal $ext ""]} {
                continue
            }
            regsub {^[.]} $ext "*." ext
@@ -306,3 +295,5 @@ proc tkFDGetFileTypes {string} {
 
     return $types
 }
+
+