head	1.14;
access;
symbols
	core-8-5-9:1.14
	core-8-5-8:1.14
	macosx-cocoa-merge:1.14
	macosx-cocoa-premerge:1.14
	macosx-carbon-freeze:1.14
	core-8-5-7:1.14
	core-8-5-6:1.14
	core-8-6-b1:1.14
	core-8-6-a3:1.14
	core-8-5-5:1.14
	core-8-6-a2:1.14
	core-8-5-4:1.14
	core-8-5-3:1.14
	core-8-6-a1:1.14
	core-8-4-19:1.9.2.1
	core-8-5-branch:1.14.0.4
	core-8-5-2:1.14
	core-8-4-18:1.9.2.1
	core-8-5-1:1.14
	core-8-4-17:1.9.2.1
	core-8-5-0:1.14
	core-8-5-b3:1.14
	core-8-5-b2:1.14
	core-8-4-16:1.9.2.1
	core-8-5-b1:1.14
	core-stablilizer-merge:1.14
	core-stabilizer-branch:1.14.0.2
	core-stabilizer-merge:1.14
	core-8-4-15:1.9.2.1
	core-8-5-a6:1.13
	core-8-5-a5:1.13
	core-8-4-14:1.9.2.1
	core-8-5-a4:1.13
	core-8-4-13:1.9.2.1
	core-8-4-12:1.9
	core-8-4-11:1.9
	core-8-5-a3:1.10
	core-8-4-10:1.9
	core-8-4-9-branch:1.9.0.6
	core-8-5-a2:1.9
	core-8-4-9:1.9
	core-8-4-8:1.9
	core-8-4-7:1.9
	core-8-5-a1:1.9
	core-8-4-6:1.9
	core-8-4-5:1.9
	mistachkin-dev-branch:1.9.0.4
	core-8-4-4:1.9
	core-8-4-3:1.9
	core-8-4-branch:1.9.0.2
	core-8-4-2:1.9
	core-8-4-1:1.8
	core-8-3-5:1.7
	core-8-4-0:1.8
	macosx-8-4-merge-2002-08-31-trunk:1.8
	macosx-8-4-premerge-2002-08-31-branch:1.8
	macosx-8-4-premerge-2002-08-31-trunk:1.8
	macosx-8-4-merge-2002-08-30-branch:1.8
	macosx-8-4-merge-2002-08-30-trunk:1.8
	macosx-8-4-merge-2002-08-20-branch:1.8
	macosx-8-4-merge-2002-08-20-trunk:1.8
	core-8-4-b2:1.8
	core-8-4-b1:1.8
	macosx-premerge-6-9-02:1.8
	core-8-4-a4:1.8
	core-8-3-4:1.7
	macosx-8-4-branch:1.8.0.2
	macosx-8-4-branchpoint:1.8
	core-8-4-a3:1.8
	core-8-3-3:1.7
	dgp-privates-into-namespace:1.7.0.6
	tclpro-1-5-0:1.7
	core-8-4-win-speedup:1.7.0.4
	core-8-4-a2:1.7
	tclpro-1-4-1:1.7
	tclpro-1-4-0:1.7
	core-8-3-2:1.7
	ajuba-ajuba2-2-1-base:1.7
	ajuba-ajuba2-2-0:1.7
	core-8-4-a1:1.7
	core-8-3-1-branch:1.7.0.2
	core-8-3-1:1.7
	scriptics-sc-2-0-b5:1.6
	scriptics-sc-2-0-fixed:1.6
	scriptics-sc-2-0-b2:1.6
	scriptics-sc-2-0-b1:1.6
	core-8-3-0:1.6
	core-8-3-b2:1.6
	core-8-3-b1:1.6
	scriptics-sc-1-1:1.4
	scriptics-sc-1-1-b1:1.4
	core-8-2-3:1.4
	scriptics-sc-1-1-branch:1.4.0.10
	scriptics-sc-1-1-base:1.4
	scriptics-sc-1-0:1.4
	scriptics-sc-1-0-branch:1.4.0.8
	scriptics-sc-1-0-base:1.4
	core-8-2-2:1.4
	core-8-2-1:1.4
	scriptics-bc-1-0-b1:1.4
	core-8-2-1-branch:1.4.0.6
	scriptics-tclpro-1-3-0:1.4
	core-8-2-0:1.4
	core-8-2-b3-branch:1.4.0.4
	core-8-2-b3-base:1.4
	scriptics-tclpro-1-3-b4:1.4
	core-8-2-b2:1.4
	scriptics-tclpro-1-3-b3:1.4
	core-8-2-b1:1.4
	scriptics-tclpro-1-3-b2:1.4
	merge-to-mainline-5/21/99:1.4
	scriptics-tclpro-1-3-b2-branch:1.4.0.2
	core-8-1-1:1.4
	scriptics-tclpro-1-3-b1:1.4
	core-8-1-1-base:1.4
	core-8-1-0:1.4
	merge-to-mainline-4-29-99:1.4
	merge-to-mainline-4-23-99:1.4
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.3.0.6
	core-8-0-6-base:1.3
	core-8-0-5:1.3
	core-8-1-b3:1.1.4.2
	core-8-1-b2:1.1.4.2
	dev-8-1-stubs-branch:1.1.4.2.0.2
	dev-stubs-branch:1.3.0.4
	scriptics-tclpro-1-2:1.3
	scriptics-tclpro-1-2-b2:1.3
	core-8-1-merge-2/10/99:1.3
	core-8-0-5-branch:1.3.0.2
	core-8-0-5-base:1.3
	scriptics-tclpro-1-2-b1:1.3
	scriptics-tclpro-1-2-a1:1.3
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.3
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.3;
locks; strict;
comment	@# @;


1.14
date	2007.05.16.18.10.35;	author dgp;	state Exp;
branches;
next	1.13;

1.13
date	2006.01.25.18.22.04;	author dgp;	state Exp;
branches;
next	1.12;

1.12
date	2005.07.25.15.31.11;	author dgp;	state Exp;
branches;
next	1.11;

1.11
date	2005.07.25.09.06.01;	author dkf;	state Exp;
branches;
next	1.10;

1.10
date	2005.04.05.13.56.35;	author dgp;	state Exp;
branches;
next	1.9;

1.9
date	2003.02.21.13.32.14;	author dkf;	state Exp;
branches
	1.9.2.1;
next	1.8;

1.8
date	2001.08.01.16.21.11;	author dgp;	state Exp;
branches;
next	1.7;

1.7
date	2000.04.08.06.59.28;	author hobbs;	state Exp;
branches
	1.7.4.1
	1.7.6.1;
next	1.6;

1.6
date	99.12.07.03.04.43;	author hobbs;	state Exp;
branches;
next	1.5;

1.5
date	99.09.02.17.02.52;	author hobbs;	state Exp;
branches;
next	1.4;

1.4
date	99.04.16.01.51.26;	author stanton;	state Exp;
branches;
next	1.3;

1.3
date	98.09.14.18.23.22;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.06.27.18.06.37;	author welch;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.55.07;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.29;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.17.31;	author stanton;	state Exp;
branches;
next	;

1.7.4.1
date	2002.04.06.01.02.01;	author hobbs;	state Exp;
branches;
next	;

1.7.6.1
date	2001.02.28.23.29.56;	author dgp;	state Exp;
branches;
next	;

1.9.2.1
date	2006.01.25.18.21.41;	author dgp;	state Exp;
branches;
next	;


desc
@@


1.14
log
@        * library/choosedir.tcl:        Removed uses of obsolete {expand}
        * library/comdlg.tcl:           syntax; replaced with the now
        * library/tk.tcl:               approved {*}.  [Bug 1710633]
        * tests/canvImg.test:
        * tests/imgPhoto.test:
@
text
@# comdlg.tcl --
#
#	Some functions needed for the common dialog boxes. Probably need to go
#	in a different file.
#
# RCS: @@(#) $Id: comdlg.tcl,v 1.13 2006/01/25 18:22:04 dgp Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# tclParseConfigSpec --
#
#	Parses a list of "-option value" pairs. If all options and
#	values are legal, the values are stored in
#	$data($option). Otherwise an error message is returned. When
#	an error happens, the data() array may have been partially
#	modified, but all the modified members of the data(0 array are
#	guaranteed to have valid values. This is different than
#	Tk_ConfigureWidget() which does not modify the value of a
#	widget record if any error occurs.
#
# Arguments:
#
# w = widget record to modify. Must be the pathname of a widget.
#
# specs = {
#    {-commandlineswitch resourceName ResourceClass defaultValue verifier}
#    {....}
# }
#
# flags = currently unused.
#
# argList = The list of  "-option value" pairs.
#
proc tclParseConfigSpec {w specs flags argList} {
    upvar #0 $w data

    # 1: Put the specs in associative arrays for faster access
    #
    foreach spec $specs {
	if {[llength $spec] < 4} {
	    error "\"spec\" should contain 5 or 4 elements"
	}
	set cmdsw [lindex $spec 0]
	set cmd($cmdsw) ""
	set rname($cmdsw)   [lindex $spec 1]
	set rclass($cmdsw)  [lindex $spec 2]
	set def($cmdsw)     [lindex $spec 3]
	set verproc($cmdsw) [lindex $spec 4]
    }

    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 \"$cmdsw\" missing"
    }

    # 2: set the default values
    #
    foreach cmdsw [array names cmd] {
	set data($cmdsw) $def($cmdsw)
    }

    # 3: parse the argument list
    #
    foreach {cmdsw value} $argList {
	if {![info exists cmd($cmdsw)]} {
	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
	}
	set data($cmdsw) $value
    }

    # Done!
}

proc tclListValidFlags {v} {
    upvar $v cmd

    set len [llength [array names cmd]]
    set i 1
    set separator ""
    set errormsg ""
    foreach cmdsw [lsort [array names cmd]] {
	append errormsg "$separator$cmdsw"
	incr i
	if {$i == $len} {
	    set separator ", or "
	} else {
	    set separator ", "
	}
    }
    return $errormsg
}

#----------------------------------------------------------------------
#
#			Focus Group
#
# Focus groups are used to handle the user's focusing actions inside a
# toplevel.
#
# One example of using focus groups is: when the user focuses on an
# entry, the text in the entry is highlighted and the cursor is put to
# the end of the text. When the user changes focus to another widget,
# the text in the previously focused entry is validated.
#
#----------------------------------------------------------------------


# ::tk::FocusGroup_Create --
#
#	Create a focus group. All the widgets in a focus group must be
#	within the same focus toplevel. Each toplevel can have only
#	one focus group, which is identified by the name of the
#	toplevel widget.
#
proc ::tk::FocusGroup_Create {t} {
    variable ::tk::Priv
    if {[winfo toplevel $t] ne $t} {
	error "$t is not a toplevel window"
    }
    if {![info exists Priv(fg,$t)]} {
	set Priv(fg,$t) 1
	set Priv(focus,$t) ""
	bind $t <FocusIn>  [list tk::FocusGroup_In  $t %W %d]
	bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d]
	bind $t <Destroy>  [list tk::FocusGroup_Destroy $t %W]
    }
}

# ::tk::FocusGroup_BindIn --
#
# Add a widget into the "FocusIn" list of the focus group. The $cmd will be
# called when the widget is focused on by the user.
#
proc ::tk::FocusGroup_BindIn {t w cmd} {
    variable FocusIn
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
	error "focus group \"$t\" doesn't exist"
    }
    set FocusIn($t,$w) $cmd
}


# ::tk::FocusGroup_BindOut --
#
#	Add a widget into the "FocusOut" list of the focus group. The
#	$cmd will be called when the widget loses the focus (User
#	types Tab or click on another widget).
#
proc ::tk::FocusGroup_BindOut {t w cmd} {
    variable FocusOut
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
	error "focus group \"$t\" doesn't exist"
    }
    set FocusOut($t,$w) $cmd
}

# ::tk::FocusGroup_Destroy --
#
#	Cleans up when members of the focus group is deleted, or when the
#	toplevel itself gets deleted.
#
proc ::tk::FocusGroup_Destroy {t w} {
    variable FocusIn
    variable FocusOut
    variable ::tk::Priv

    if {$t eq $w} {
	unset Priv(fg,$t)
	unset Priv(focus,$t) 

	foreach name [array names FocusIn $t,*] {
	    unset FocusIn($name)
	}
	foreach name [array names FocusOut $t,*] {
	    unset FocusOut($name)
	}
    } else {
	if {[info exists Priv(focus,$t)] && ($Priv(focus,$t) eq $w)} {
	    set Priv(focus,$t) ""
	}
	unset -nocomplain FocusIn($t,$w) FocusOut($t,$w)
    }
}

# ::tk::FocusGroup_In --
#
#	Handles the <FocusIn> event. Calls the FocusIn command for the newly
#	focused widget in the focus group.
#
proc ::tk::FocusGroup_In {t w detail} {
    variable FocusIn
    variable ::tk::Priv

    if {$detail ne "NotifyNonlinear" && $detail ne "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 FocusIn($t,$w)]} {
	set FocusIn($t,$w) ""
	return
    }
    if {![info exists Priv(focus,$t)]} {
	return
    }
    if {$Priv(focus,$t) eq $w} {
	# This is already in focus
	#
	return
    } else {
	set Priv(focus,$t) $w
	eval $FocusIn($t,$w)
    }
}

# ::tk::FocusGroup_Out --
#
#	Handles the <FocusOut> event. Checks if this is really a lose
#	focus event, not one generated by the mouse moving out of the
#	toplevel window.  Calls the FocusOut command for the widget
#	who loses its focus.
#
proc ::tk::FocusGroup_Out {t w detail} {
    variable FocusOut
    variable ::tk::Priv

    if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
	# This is caused by mouse moving out of the window
	return
    }
    if {![info exists Priv(focus,$t)]} {
	return
    }
    if {![info exists FocusOut($t,$w)]} {
	return
    } else {
	eval $FocusOut($t,$w)
	set Priv(focus,$t) ""
    }
}

# ::tk::FDGetFileTypes --
#
#	Process the string given by the -filetypes option of the file
#	dialogs. Similar to the C function TkGetFileFilters() on the Mac
#	and Windows platform.
#
proc ::tk::FDGetFileTypes {string} {
    foreach t $string {
	if {[llength $t] < 2 || [llength $t] > 3} {
	    error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
	}
	lappend fileTypes([lindex $t 0]) {*}[lindex $t 1]
    }

    set types {}
    foreach t $string {
	set label [lindex $t 0]
	set exts {}

	if {[info exists hasDoneType($label)]} {
	    continue
	}

	# Validate each macType.  This is to agree with the 
	# behaviour of TkGetFileFilters().  This list may be
	# empty.
	foreach macType [lindex $t 2] {
	    if {[string length $macType] != 4} {
		error "bad Macintosh file type \"$macType\""
	    }
	}
	
	set name "$label \("
	set sep ""
	set doAppend 1
	foreach ext $fileTypes($label) {
	    if {$ext eq ""} {
		continue
	    }
	    regsub {^[.]} $ext "*." ext
	    if {![info exists hasGotExt($label,$ext)]} {
		if {$doAppend} {
		    if {[string length $sep] && [string length $name]>40} {
			set doAppend 0
			append name $sep...
		    } else {
			append name $sep$ext
		    }
		}
		lappend exts $ext
		set hasGotExt($label,$ext) 1
	    }
	    set sep ","
	}
	append name "\)"
	lappend types [list $name $exts]

	set hasDoneType($label) 1
    }

    return $types
}
@


1.13
log
@        * library/bgerror.tcl:  Updates to use Tcl 8.4 features. [Patch 1237759]        * library/choosedir.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/focus.tcl:
        * library/msgbox.tcl:
        * library/palette.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.12 2005/07/25 15:31:11 dgp Exp $
d262 1
a262 1
	lappend fileTypes([lindex $t 0]) {expand}[lindex $t 1]
@


1.12
log
@typo fix
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.11 2005/07/25 09:06:01 dkf Exp $
d190 1
a190 6
	catch {
	    unset FocusIn($t,$w)
	}
	catch {
	    unset FocusOut($t,$w)
	}
d283 1
a283 1
	set name "$label ("
d303 1
a303 1
	    set sep ,
d305 1
a305 1
	append name ")"
@


1.11
log
@Apply some of the changes suggested in [Patch 1237759]
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.10 2005/04/05 13:56:35 dgp Exp $
d208 1
a208 1
    if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"]} {
@


1.10
log
@        * library/comdlg.tcl:  Added Macintosh file type validation to
        [::tk::FDGetFileTypes].  [Bug 1083878]  (Thanks, Vince Darley)
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.9 2003/02/21 13:32:14 dkf Exp $
d124 1
a124 1
    if {[string compare [winfo toplevel $t] $t]} {
d176 1
a176 1
    if {[string equal $t $w]} {
d187 1
a187 2
	if {[info exists Priv(focus,$t)] && \
		[string equal $Priv(focus,$t) $w]} {
d208 1
a208 2
    if {[string compare $detail NotifyNonlinear] && \
	    [string compare $detail NotifyNonlinearVirtual]} {
d220 1
a220 1
    if {[string equal $Priv(focus,$t) $w]} {
d241 1
a241 2
    if {[string compare $detail NotifyNonlinear] && \
	    [string compare $detail NotifyNonlinearVirtual]} {
d267 1
a267 1
	eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]
d292 1
a292 1
	    if {[string equal $ext ""]} {
@


1.9
log
@	* library/comdlg.tcl (FDGetFileTypes): Set an upper limit on how
	long a file type item description string can get due to appending
	of types. [Bug #617392]
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.8 2001/08/01 16:21:11 dgp Exp $
d282 9
@


1.9.2.1
log
@        * library/bgerror.tcl:  Updates to use Tcl 8.4 features. [Patch 1237759]        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/palette.tcl:
        * library/panedwindow.tcl:
        * library/safetk.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.9 2003/02/21 13:32:14 dkf Exp $
d124 1
a124 1
    if {[winfo toplevel $t] ne $t} {
d176 1
a176 1
    if {$t eq $w} {
d187 2
a188 1
	if {[info exists Priv(focus,$t)] && $Priv(focus,$t) eq $w} {
d191 6
a196 1
	unset -nocomplain FocusIn($t,$w) FocusOut($t,$w)
d209 2
a210 1
    if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
d222 1
a222 1
    if {$Priv(focus,$t) eq $w} {
d243 2
a244 1
    if {$detail ne "NotifyNonlinear" && $detail ne "NotifyNonlinearVirtual"} {
d282 1
a282 1
	set name "$label \("
d286 1
a286 1
	    if {$ext eq ""} {
d302 1
a302 1
	    set sep ","
d304 1
a304 1
	append name "\)"
@


1.8
log
@	Merged changes from feature branch dgp-privates-into-namespace,
	implementing TIP 44.  All Tk commands and variables matching
	tk[A-Z]* are now in the ::tk namespace.
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.7 2000/04/08 06:59:28 hobbs Exp $
d284 1
d291 8
a298 1
		append name $sep$ext
@


1.7
log
@	* library/safetk.tcl (disallowTk): made disallowTk work in the
	simple case.

	* library/comdlg.tcl (tkFocusGroup_In): fixed key navigation
	problems in dialogs under CDE [Bug: 2960]
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.6 1999/12/07 03:04:43 hobbs Exp $
d115 1
a115 1
# tkFocusGroup_Create --
d122 2
a123 2
proc tkFocusGroup_Create {t} {
    global tkPriv
d127 6
a132 6
    if {![info exists tkPriv(fg,$t)]} {
	set tkPriv(fg,$t) 1
	set tkPriv(focus,$t) ""
	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]
d136 1
a136 1
# tkFocusGroup_BindIn --
d141 4
a144 3
proc tkFocusGroup_BindIn {t w cmd} {
    global tkFocusIn tkPriv
    if {![info exists tkPriv(fg,$t)]} {
d147 1
a147 1
    set tkFocusIn($t,$w) $cmd
d151 1
a151 1
# tkFocusGroup_BindOut --
d157 4
a160 3
proc tkFocusGroup_BindOut {t w cmd} {
    global tkFocusOut tkPriv
    if {![info exists tkPriv(fg,$t)]} {
d163 1
a163 1
    set tkFocusOut($t,$w) $cmd
d166 1
a166 1
# tkFocusGroup_Destroy --
d171 4
a174 2
proc tkFocusGroup_Destroy {t w} {
    global tkPriv tkFocusIn tkFocusOut
d177 2
a178 2
	unset tkPriv(fg,$t)
	unset tkPriv(focus,$t) 
d180 2
a181 2
	foreach name [array names tkFocusIn $t,*] {
	    unset tkFocusIn($name)
d183 2
a184 2
	foreach name [array names tkFocusOut $t,*] {
	    unset tkFocusOut($name)
d187 3
a189 3
	if {[info exists tkPriv(focus,$t)] && \
		[string equal $tkPriv(focus,$t) $w]} {
	    set tkPriv(focus,$t) ""
d192 1
a192 1
	    unset tkFocusIn($t,$w)
d195 1
a195 1
	    unset tkFocusOut($t,$w)
d200 1
a200 1
# tkFocusGroup_In --
d205 3
a207 2
proc tkFocusGroup_In {t w detail} {
    global tkPriv tkFocusIn
d215 2
a216 2
    if {![info exists tkFocusIn($t,$w)]} {
	set tkFocusIn($t,$w) ""
d219 1
a219 1
    if {![info exists tkPriv(focus,$t)]} {
d222 1
a222 1
    if {[string equal $tkPriv(focus,$t) $w]} {
d227 2
a228 2
	set tkPriv(focus,$t) $w
	eval $tkFocusIn($t,$w)
d232 1
a232 1
# tkFocusGroup_Out --
d239 3
a241 2
proc tkFocusGroup_Out {t w detail} {
    global tkPriv tkFocusOut
d248 1
a248 1
    if {![info exists tkPriv(focus,$t)]} {
d251 1
a251 1
    if {![info exists tkFocusOut($t,$w)]} {
d254 2
a255 2
	eval $tkFocusOut($t,$w)
	set tkPriv(focus,$t) ""
d259 1
a259 1
# tkFDGetFileTypes --
d265 1
a265 1
proc tkFDGetFileTypes {string} {
@


1.7.4.1
log
@update to head
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.8 2001/08/01 16:21:11 dgp Exp $
d115 1
a115 1
# ::tk::FocusGroup_Create --
d122 2
a123 2
proc ::tk::FocusGroup_Create {t} {
    variable ::tk::Priv
d127 6
a132 6
    if {![info exists Priv(fg,$t)]} {
	set Priv(fg,$t) 1
	set Priv(focus,$t) ""
	bind $t <FocusIn>  [list tk::FocusGroup_In  $t %W %d]
	bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d]
	bind $t <Destroy>  [list tk::FocusGroup_Destroy $t %W]
d136 1
a136 1
# ::tk::FocusGroup_BindIn --
d141 3
a143 4
proc ::tk::FocusGroup_BindIn {t w cmd} {
    variable FocusIn
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
d146 1
a146 1
    set FocusIn($t,$w) $cmd
d150 1
a150 1
# ::tk::FocusGroup_BindOut --
d156 3
a158 4
proc ::tk::FocusGroup_BindOut {t w cmd} {
    variable FocusOut
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
d161 1
a161 1
    set FocusOut($t,$w) $cmd
d164 1
a164 1
# ::tk::FocusGroup_Destroy --
d169 2
a170 4
proc ::tk::FocusGroup_Destroy {t w} {
    variable FocusIn
    variable FocusOut
    variable ::tk::Priv
d173 2
a174 2
	unset Priv(fg,$t)
	unset Priv(focus,$t) 
d176 2
a177 2
	foreach name [array names FocusIn $t,*] {
	    unset FocusIn($name)
d179 2
a180 2
	foreach name [array names FocusOut $t,*] {
	    unset FocusOut($name)
d183 3
a185 3
	if {[info exists Priv(focus,$t)] && \
		[string equal $Priv(focus,$t) $w]} {
	    set Priv(focus,$t) ""
d188 1
a188 1
	    unset FocusIn($t,$w)
d191 1
a191 1
	    unset FocusOut($t,$w)
d196 1
a196 1
# ::tk::FocusGroup_In --
d201 2
a202 3
proc ::tk::FocusGroup_In {t w detail} {
    variable FocusIn
    variable ::tk::Priv
d210 2
a211 2
    if {![info exists FocusIn($t,$w)]} {
	set FocusIn($t,$w) ""
d214 1
a214 1
    if {![info exists Priv(focus,$t)]} {
d217 1
a217 1
    if {[string equal $Priv(focus,$t) $w]} {
d222 2
a223 2
	set Priv(focus,$t) $w
	eval $FocusIn($t,$w)
d227 1
a227 1
# ::tk::FocusGroup_Out --
d234 2
a235 3
proc ::tk::FocusGroup_Out {t w detail} {
    variable FocusOut
    variable ::tk::Priv
d242 1
a242 1
    if {![info exists Priv(focus,$t)]} {
d245 1
a245 1
    if {![info exists FocusOut($t,$w)]} {
d248 2
a249 2
	eval $FocusOut($t,$w)
	set Priv(focus,$t) ""
d253 1
a253 1
# ::tk::FDGetFileTypes --
d259 1
a259 1
proc ::tk::FDGetFileTypes {string} {
@


1.7.6.1
log
@2001-02-28  Don Porter  <dgp@@users.sourceforge.net>

        BRANCH dgp-privates-into-namespace:  Feature branch to move all
        of Tk's private commands and variable into the ::tk namespace
        and its children.

        * doc/tkvars.n:  Documented private variable tkPriv renamed tk::Priv.

        * generic/tkBind.c:
        * generic/tkMenu.c:
        * generic/tkTextDisp.c:
        * library/bgerror.tcl:
        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/optMenu.tcl:
        * library/palette.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tclIndex:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
        * mac/tkMacMenu.c:
        * tests/clrpick.test:
        * tests/filebox.test:
        * tests/macMenu.test:
        * tests/menu.test:
        * tests/menuDraw.test:
        * tests/msgbox.test:
        * tests/text.test:
        * tests/textDisp.test:
        * tests/unixMenu.test:
        * tests/winMenu.test:
        * tests/xmfbox.test:
        * unix/tkUnixDialog.c:  All Tk commands matching ::tk[A-Z]* and
        all Tk private variables in the global namespace were renamed to
        live in the namespace ::tk or one of its children.
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.7 2000/04/08 06:59:28 hobbs Exp $
d115 1
a115 1
# ::tk::FocusGroup_Create --
d122 2
a123 2
proc ::tk::FocusGroup_Create {t} {
    variable ::tk::Priv
d127 6
a132 6
    if {![info exists Priv(fg,$t)]} {
	set Priv(fg,$t) 1
	set Priv(focus,$t) ""
	bind $t <FocusIn>  [list tk::FocusGroup_In  $t %W %d]
	bind $t <FocusOut> [list tk::FocusGroup_Out $t %W %d]
	bind $t <Destroy>  [list tk::FocusGroup_Destroy $t %W]
d136 1
a136 1
# ::tk::FocusGroup_BindIn --
d141 3
a143 4
proc ::tk::FocusGroup_BindIn {t w cmd} {
    variable FocusIn
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
d146 1
a146 1
    set FocusIn($t,$w) $cmd
d150 1
a150 1
# ::tk::FocusGroup_BindOut --
d156 3
a158 4
proc ::tk::FocusGroup_BindOut {t w cmd} {
    variable FocusOut
    variable ::tk::Priv
    if {![info exists Priv(fg,$t)]} {
d161 1
a161 1
    set FocusOut($t,$w) $cmd
d164 1
a164 1
# ::tk::FocusGroup_Destroy --
d169 2
a170 4
proc ::tk::FocusGroup_Destroy {t w} {
    variable FocusIn
    variable FocusOut
    variable ::tk::Priv
d173 2
a174 2
	unset Priv(fg,$t)
	unset Priv(focus,$t) 
d176 2
a177 2
	foreach name [array names FocusIn $t,*] {
	    unset FocusIn($name)
d179 2
a180 2
	foreach name [array names FocusOut $t,*] {
	    unset FocusOut($name)
d183 3
a185 3
	if {[info exists Priv(focus,$t)] && \
		[string equal $Priv(focus,$t) $w]} {
	    set Priv(focus,$t) ""
d188 1
a188 1
	    unset FocusIn($t,$w)
d191 1
a191 1
	    unset FocusOut($t,$w)
d196 1
a196 1
# ::tk::FocusGroup_In --
d201 2
a202 3
proc ::tk::FocusGroup_In {t w detail} {
    variable FocusIn
    variable ::tk::Priv
d210 2
a211 2
    if {![info exists FocusIn($t,$w)]} {
	set FocusIn($t,$w) ""
d214 1
a214 1
    if {![info exists Priv(focus,$t)]} {
d217 1
a217 1
    if {[string equal $Priv(focus,$t) $w]} {
d222 2
a223 2
	set Priv(focus,$t) $w
	eval $FocusIn($t,$w)
d227 1
a227 1
# ::tk::FocusGroup_Out --
d234 2
a235 3
proc ::tk::FocusGroup_Out {t w detail} {
    variable FocusOut
    variable ::tk::Priv
d242 1
a242 1
    if {![info exists Priv(focus,$t)]} {
d245 1
a245 1
    if {![info exists FocusOut($t,$w)]} {
d248 2
a249 2
	eval $FocusOut($t,$w)
	set Priv(focus,$t) ""
d253 1
a253 1
# ::tk::FDGetFileTypes --
d259 1
a259 1
proc ::tk::FDGetFileTypes {string} {
@


1.6
log
@	* library/comdlg.tcl: removed tclVerifyInteger and tclSortNoCase,
	they weren't used, and were not actually correct
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.5 1999/09/02 17:02:52 hobbs Exp $
d204 6
d237 2
a238 2
    if {[string compare $detail NotifyNonlinear] &&
	[string compare $detail NotifyNonlinearVirtual]} {
@


1.5
log
@1999-09-01  Jeff Hobbs  <hobbs@@scriptics.com>

	* library/msgbox.tcl: changed the behavior of tk_messageBox on
	Unix to be more Windows like in handling of <Return> and the
	default button
	* library/button.tcl:
	* library/clrpick.tcl:
	* library/comdlg.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/focus.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/palette.tcl:
	* library/safetk.tcl:
	* library/scale.tcl:
	* library/scrlbar.tcl:
	* library/tearoff.tcl:
	* library/text.tcl:
	* library/tk.tcl:
	* library/tkfbox.tcl:
	* library/xmfbox.tcl: updated commands to use [string] ops
	instead of expr equality operators
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
a98 15

# This procedure is used to sort strings in a case-insenstive mode.
#
proc tclSortNoCase {str1 str2} {
    string compare -nocase $str1 $str2
}


# Gives an error if the string does not contain a valid integer
# number
#
proc tclVerifyInteger {string} {
    lindex {1 2 3} $string
}

@


1.4
log
@* Merged 8.1 branch into the main trunk
@
text
@d6 1
a6 1
# RCS: @@(#) $Id$
d103 1
a103 1
    return [string compare [string toupper $str1] [string toupper $str2]]
d145 3
a147 3
	bind $t <FocusIn>  "tkFocusGroup_In  $t %W %d"
	bind $t <FocusOut> "tkFocusGroup_Out $t %W %d"
	bind $t <Destroy>  "tkFocusGroup_Destroy $t %W"
d187 1
a187 1
    if {![string compare $t $w]} {
d198 3
a200 4
	if {[info exists tkPriv(focus,$t)]} {
	    if {![string compare $tkPriv(focus,$t) $w]} {
		set tkPriv(focus,$t) ""
	    }
d226 1
a226 1
    if {![string compare $tkPriv(focus,$t) $w]} {
d288 1
a288 1
	    if {![string compare $ext ""]} {
@


1.3
log
@Replaced SCCS strings, fixed binary files
@
text
@d55 4
a58 5
    if {([llength $argList]%2) != 0} {
	foreach {cmdsw value} $argList {
	    if {![info exists cmd($cmdsw)]} {
	        error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
	    }
d60 1
a60 1
	error "value for \"[lindex $argList end]\" missing"
d73 1
a73 1
	    error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
d92 1
a92 1
	    set separator " or "
@


1.2
log
@plugin updates
@
text
@d6 1
a6 1
# SCCS: @@(#) comdlg.tcl 1.4 96/09/05 09:07:54
@


1.1
log
@Initial revision
@
text
@d55 1
a55 1
    if {[expr [llength $argList] %2] != 0} {
d57 1
a57 1
	    if ![info exists cmd($cmdsw)] {
d73 1
a73 1
	if ![info exists cmd($cmdsw)] {
d140 1
a140 1
    if [string compare [winfo toplevel $t] $t] {
d143 1
a143 1
    if ![info exists tkPriv(fg,$t)] {
d159 1
a159 1
    if ![info exists tkPriv(fg,$t)] {
d174 1
a174 1
    if ![info exists tkPriv(fg,$t)] {
d188 1
a188 1
    if ![string compare $t $w] {
d199 2
a200 2
	if [info exists tkPriv(focus,$t)] {
	    if ![string compare $tkPriv(focus,$t) $w] {
d221 1
a221 1
    if ![info exists tkFocusIn($t,$w)] {
d225 1
a225 1
    if ![info exists tkPriv(focus,$t)] {
d228 1
a228 1
    if ![string compare $tkPriv(focus,$t) $w] {
d253 1
a253 1
    if ![info exists tkPriv(focus,$t)] {
d256 1
a256 1
    if ![info exists tkFocusOut($t,$w)] {
d283 1
a283 1
	if [info exists hasDoneType($label)] {
d290 1
a290 1
	    if ![string compare $ext ""] {
d294 1
a294 1
	    if ![info exists hasGotExt($label,$ext)] {
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d6 1
a6 1
# SCCS: @@(#) comdlg.tcl 1.6 97/12/03 17:09:19
d55 5
a59 4
    if {[llength $argList] & 1} {
	set cmdsw [lindex $argList end]
	if {![info exists cmd($cmdsw)]} {
	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
d61 1
a61 1
	error "value for \"$cmdsw\" missing"
d73 2
a74 2
	if {![info exists cmd($cmdsw)]} {
	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
d93 1
a93 1
	    set separator ", or "
d140 1
a140 1
    if {[string compare [winfo toplevel $t] $t]} {
d143 1
a143 1
    if {![info exists tkPriv(fg,$t)]} {
d159 1
a159 1
    if {![info exists tkPriv(fg,$t)]} {
d174 1
a174 1
    if {![info exists tkPriv(fg,$t)]} {
d188 1
a188 1
    if {![string compare $t $w]} {
d199 2
a200 2
	if {[info exists tkPriv(focus,$t)]} {
	    if {![string compare $tkPriv(focus,$t) $w]} {
d221 1
a221 1
    if {![info exists tkFocusIn($t,$w)]} {
d225 1
a225 1
    if {![info exists tkPriv(focus,$t)]} {
d228 1
a228 1
    if {![string compare $tkPriv(focus,$t) $w]} {
d253 1
a253 1
    if {![info exists tkPriv(focus,$t)]} {
d256 1
a256 1
    if {![info exists tkFocusOut($t,$w)]} {
d283 1
a283 1
	if {[info exists hasDoneType($label)]} {
d290 1
a290 1
	    if {![string compare $ext ""]} {
d294 1
a294 1
	    if {![info exists hasGotExt($label,$ext)]} {
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d6 1
a6 1
# RCS: @@(#) $Id: comdlg.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $
@


