comdlg.tcl revision 3f54fd611f536639ec30dd53c48e5ec1897cc7d9
# comdlg.tcl --
#
# 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
#
# 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.
#
upvar #0 $w data
# 1: Put the specs in associative arrays for faster access
#
error "\"spec\" should contain 5 or 4 elements"
}
}
error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
}
}
error "value for \"[lindex $argList end]\" missing"
}
# 2: set the default values
#
}
# 3: parse the argument list
#
error "unknown option \"$cmdsw\", must be [tclListValidFlags cmd]"
}
}
# Done!
}
proc tclListValidFlags {v} {
set separator ""
set errormsg ""
append errormsg "$separator$cmdsw"
incr i
set separator " or "
} else {
set separator ", "
}
}
return $errormsg
}
# This procedure is used to sort strings in a case-insenstive mode.
#
}
# Gives an error if the string does not contain a valid integer
# number
#
proc tclVerifyInteger {string} {
}
#----------------------------------------------------------------------
#
# 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.
#
#----------------------------------------------------------------------
# tkFocusGroup_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 tkFocusGroup_Create {t} {
global tkPriv
error "$t is not a toplevel window"
}
}
}
# tkFocusGroup_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.
#
error "focus group \"$t\" doesn't exist"
}
}
# tkFocusGroup_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).
#
global tkFocusOut tkPriv
error "focus group \"$t\" doesn't exist"
}
}
# tkFocusGroup_Destroy --
#
# Cleans up when members of the focus group is deleted, or when the
# toplevel itself gets deleted.
#
}
unset tkFocusOut($name)
}
} else {
}
}
catch {
}
catch {
}
}
}
# tkFocusGroup_In --
#
# Handles the <FocusIn> event. Calls the FocusIn command for the newly
# focused widget in the focus group.
#
return
}
return
}
# This is already in focus
#
return
} else {
}
}
# tkFocusGroup_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.
#
global tkPriv tkFocusOut
# This is caused by mouse moving out of the window
return
}
return
}
return
} else {
}
}
# tkFDGetFileTypes --
#
# 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 tkFDGetFileTypes {string} {
foreach t $string {
error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
}
}
set types {}
foreach t $string {
set exts {}
if [info exists hasDoneType($label)] {
continue
}
set name "$label ("
set sep ""
continue
}
}
set sep ,
}
append name ")"
set hasDoneType($label) 1
}
return $types
}