xmfbox.tcl

genesis 2000 v9.1软件下载

# xmfbox.tcl --
#
#	Implements the "Motif" style file selection dialog for the
#	Unix platform. This implementation is used only if the
#	"tk_strictMotif" flag is set.
#
# SCCS: @(#) xmfbox.tcl 1.5 96/10/04 17:09:24
#
# 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.
#


# tkMotifFDialog --
#
#	Implements a file dialog similar to the standard Motif file
#	selection box.
#
# Return value:
#
#	A list of two members. The first member is the absolute
#	pathname of the selected file or "" if user hits cancel. The
#	second member is the name of the selected file type, or ""
#	which stands for "default file type"
#
proc tkMotifFDialog {args} {
    global tkPriv
    set w .__tk_filedialog
    upvar #0 $w data

    if ![string compare [lindex [info level 0] 0] tk_getOpenFile] {
	set type open
    } else {
	set type save
    }

    tkMotifFDialog_Config $w $type $args

    # (re)create the dialog box if necessary
    #
    if {![winfo exists $w]} {
	tkMotifFDialog_Create $w
    } elseif {[string compare [winfo class $w] TkMotifFDialog]} {
	destroy $w
	tkMotifFDialog_Create $w
    }
    wm transient $w $data(-parent)

    tkMotifFDialog_Update $w

    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
	    - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
	    - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w
    wm title $w $data(-title)

    # 6. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    focus $data(sEnt)
    $data(sEnt) select from 0
    $data(sEnt) select to   end

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(selectFilePath)
    catch {focus $oldFocus}
    grab release $w
    wm withdraw $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(selectFilePath)
}

proc tkMotifFDialog_Config {w type argList} {
    upvar #0 $w data

    set data(type) $type

    # 1: the configuration specs
    #
    set specs {
	{-defaultextension "" "" ""}
	{-filetypes "" "" ""}
	{-initialdir "" "" ""}
	{-initialfile "" "" ""}
	{-parent "" "" "."}
	{-title "" "" ""}
    }

    # 2: default values depending on the type of the dialog
    #
    if ![info exists data(selectPath)] {
	# first time the dialog has been popped up
	set data(selectPath) [pwd]
	set data(selectFile) ""
    }

    # 3: parse the arguments
    #
    tclParseConfigSpec $w $specs "" $argList

    if ![string compare $data(-title) ""] {
	if ![string compare $type "open"] {
	    set data(-title) "Open"
	} else {
	    set data(-title) "Save As"
	}
    }

    # 4: set the default directory and selection according to the -initial
    #    settings
    #
    if [string compare $data(-initialdir) ""] {
	if [file isdirectory $data(-initialdir)] {
	    set data(selectPath) [glob $data(-initialdir)]
	} else {
	    error "\"$data(-initialdir)\" is not a valid directory"
	}
    }
    set data(selectFile) $data(-initialfile)

    # 5. Parse the -filetypes option. It is not used by the motif
    #    file dialog, but we check for validity of the value to make sure
    #    the application code also runs fine with the TK file dialog.
    #
    set data(-filetypes) [tkFDGetFileTypes $data(-filetypes)]

    if ![info exists data(filter)] {
	set data(filter) *
    }
    if ![winfo exists $data(-parent)] {
	error "bad window path name \"$data(-parent)\""
    }
}

proc tkMotifFDialog_Create {w} {
    upvar #0 $w data

    # 1: Create the dialog ...
    #
    toplevel $w -class TkMotifFDialog
    set top [frame $w.top -relief raised -bd 1]
    set bot [frame $w.bot -relief raised -bd 1]

    pack $w.bot -side bottom -fill x
    pack $w.top -side top -expand yes -fill both

    set f1 [frame $top.f1]
    set f2 [frame $top.f2]
    set f3 [frame $top.f3]

    pack $f1 -side top    -fill x
    pack $f3 -side bottom -fill x
    pack $f2 -expand yes -fill both

    set f2a [frame $f2.a]
    set f2b [frame $f2.b]

    grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
	-sticky news
    grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
	-sticky news
    grid rowconfig $f2 0    -minsize 0   -weight 1
    grid columnconfig $f2 0 -minsize 0   -weight 1
    grid columnconfig $f2 1 -minsize 150 -weight 2

    # The Filter box
    #
    label $f1.lab -text "Filter:" -under 3 -anchor w
    entry $f1.ent
    pack $f1.lab -side top -fill x -padx 6 -pady 4
    pack $f1.ent -side top -fill x -padx 4 -pady 0
    set data(fEnt) $f1.ent

    # The file and directory lists
    #
    set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]
    set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files:     2 FList]

    # The Selection box
    #
    label $f3.lab -text "Selection:" -under 0 -anchor w
    entry $f3.ent
    pack $f3.lab -side top -fill x -padx 6 -pady 0
    pack $f3.ent -side top -fill x -padx 4 -pady 4
    set data(sEnt) $f3.ent

    # The buttons
    #
    set data(okBtn) [button $bot.ok     -text OK     -width 6 -under 0 \
	-command "tkMotifFDialog_OkCmd $w"]
    set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
	-command "tkMotifFDialog_FilterCmd $w"]
    set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
	-command "tkMotifFDialog_CancelCmd $w"]

    pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
	-side left

    # Create the bindings:
    #
    bind $w <Alt-t> "focus $data(fEnt)"
    bind $w <Alt-d> "focus $data(dList)"
    bind $w <Alt-l> "focus $data(fList)"
    bind $w <Alt-s> "focus $data(sEnt)"

    bind $w <Alt-o> "tkButtonInvoke $bot.ok    "
    bind $w <Alt-f> "tkButtonInvoke $bot.filter"
    bind $w <Alt-c> "tkButtonInvoke $bot.cancel"

    bind $data(fEnt) <Return> "tkMotifFDialog_ActivateFEnt $w"
    bind $data(sEnt) <Return> "tkMotifFDialog_ActivateSEnt $w"

    wm protocol $w WM_DELETE_WINDOW "tkMotifFDialog_CancelCmd $w"
}

proc tkMotifFDialog_MakeSList {w f label under cmd} {
    label $f.lab -text $label -under $under -anchor w
    listbox $f.l -width 12 -height 5 -selectmode browse -exportselection 0\
	-xscrollcommand "$f.h set" \
	-yscrollcommand "$f.v set" 
    scrollbar $f.v -orient vertical   -takefocus 0 \
	-command "$f.l yview"
    scrollbar $f.h -orient horizontal -takefocus 0 \
	-command "$f.l xview"
    grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
	-padx 2 -pady 2
    grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
    grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
    grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news

    grid rowconfig    $f 0 -weight 0 -minsize 0
    grid rowconfig    $f 1 -weight 1 -minsize 0
    grid columnconfig $f 0 -weight 1 -minsize 0

    # bindings for the listboxes
    #
    set list $f.l
    bind $list <Up>        "tkMotifFDialog_Browse$cmd $w"
    bind $list <Down>      "tkMotifFDialog_Browse$cmd $w"
    bind $list <space>     "tkMotifFDialog_Browse$cmd $w"
    bind $list <1>         "tkMotifFDialog_Browse$cmd $w"
    bind $list <B1-Motion> "tkMotifFDialog_Browse$cmd $w"
    bind $list <Double-1>  "tkMotifFDialog_Activate$cmd $w"
    bind $list <Return>    "tkMotifFDialog_Browse$cmd $w; tkMotifFDialog_Activate$cmd $w"

    bindtags $list "Listbox $list [winfo toplevel $list] all"
    tkListBoxKeyAccel_Set $list

    return $f.l
}

proc tkMotifFDialog_BrowseDList {w} {
    upvar #0 $w data

    focus $data(dList)
    if ![string compare [$data(dList) curselection] ""] {
	return
    }
    set subdir [$data(dList) get [$data(dList) curselection]]
    if ![string compare $subdir ""] {
	return
    }

    $data(fList) selection clear 0 end

    set list [tkMotifFDialog_InterpFilter $w]
    set data(filter) [lindex $list 1]

    case $subdir {
	. {
	    set newSpec [file join $data(selectPath) $data(filter)]
	}
	.. {
	    set newSpec [file join [file dirname $data(selectPath)] \
		$data(filter)]
	}
	default {
	    set newSpec [file join $data(selectPath) $subdir $data(filter)]
	}
    }

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 $newSpec
}

proc tkMotifFDialog_ActivateDList {w} {
    upvar #0 $w data

    if ![string compare [$data(dList) curselection] ""] {