xmfbox.tcl

基于语义本体的单词查询系统

# Results:
#	None.

proc tkMotifFDialog_Update {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 \
            [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
	    $data(selectFile)]
 
    tkMotifFDialog_LoadFiles $w
}

# tkMotifFDialog_LoadFiles --
#
#	Loads the files and directories into the two listboxes according
#	to the filter setting.
#
# Arguments:
# 	w 		pathname of the dialog box.
#
# Results:
#	None.

proc tkMotifFDialog_LoadFiles {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    $data(dList) delete 0 end
    $data(fList) delete 0 end

    set appPWD [pwd]
    if {[catch {cd $data(selectPath)}]} {
	cd $appPWD

	$data(dList) insert end ".."
	return
    }

    # Make the dir and file lists
    #
    # For speed we only have one glob, which reduces the file system
    # calls (good for slow NFS networks).
    #
    # We also do two smaller sorts (files + dirs) instead of one large sort,
    # which gives a small speed increase.
    #
    set top 0
    set dlist ""
    set flist ""
    foreach f [glob -nocomplain .* *] {
	if {[file isdir ./$f]} {
	    lappend dlist $f
	} else {
            foreach pat $data(filter) {
                if {[string match $pat $f]} {
		if {[string match .* $f]} {
		    incr top
		}
		lappend flist $f
                    break
	    }
            }
	}
    }
    eval [list $data(dList) insert end] [lsort -dictionary $dlist]
    eval [list $data(fList) insert end] [lsort -dictionary $flist]

    # The user probably doesn't want to see the . files. We adjust the view
    # so that the listbox displays all the non-dot files
    $data(fList) yview $top

    cd $appPWD
}

# tkMotifFDialog_BrowseFList --
#
#	This procedure is called when the directory list is browsed
#	(clicked-over) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_BrowseDList {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

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

    $data(fList) selection clear 0 end

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

    switch -- $subdir {
	. {
	    set newSpec [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
	}
	.. {
	    set newSpec [::tk::dialog::file::JoinFile [file dirname $data(selectPath)] \
		$data(filter)]
	}
	default {
	    set newSpec [::tk::dialog::file::JoinFile [::tk::dialog::file::JoinFile \
		    $data(selectPath) $subdir] $data(filter)]
	}
    }

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

# tkMotifFDialog_ActivateDList --
#
#	This procedure is called when the directory list is activated
#	(double-clicked) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateDList {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

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

    $data(fList) selection clear 0 end

    switch -- $subdir {
	. {
	    set newDir $data(selectPath)
	}
	.. {
	    set newDir [file dirname $data(selectPath)]
	}
	default {
	    set newDir [::tk::dialog::file::JoinFile $data(selectPath) $subdir]
	}
    }

    set data(selectPath) $newDir
    tkMotifFDialog_Update $w

    if {[string compare $subdir ..]} {
	$data(dList) selection set 0
	$data(dList) activate 0
    } else {
	$data(dList) selection set 1
	$data(dList) activate 1
    }
}

# tkMotifFDialog_BrowseFList --
#
#	This procedure is called when the file list is browsed
#	(clicked-over) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_BrowseFList {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    focus $data(fList)
    if {[string equal [$data(fList) curselection] ""]} {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if {[string equal $data(selectFile) ""]} {
	return
    }

    $data(dList) selection clear 0 end

    $data(fEnt) delete 0 end
    $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) $data(filter)]
    $data(fEnt) xview end
 
    $data(sEnt) delete 0 end
    $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \
	    $data(selectFile)]
    $data(sEnt) xview end
}

# tkMotifFDialog_ActivateFList --
#
#	This procedure is called when the file list is activated
#	(double-clicked) by the user.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateFList {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    if {[string equal [$data(fList) curselection] ""]} {
	return
    }
    set data(selectFile) [$data(fList) get [$data(fList) curselection]]
    if {[string equal $data(selectFile) ""]} {
	return
    } else {
	tkMotifFDialog_ActivateSEnt $w
    }
}

# tkMotifFDialog_ActivateFEnt --
#
#	This procedure is called when the user presses Return inside
#	the "filter" entry. It updates the dialog according to the
#	text inside the filter entry.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateFEnt {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

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

    tkMotifFDialog_Update $w
}

# tkMotifFDialog_ActivateSEnt --
#
#	This procedure is called when the user presses Return inside
#	the "selection" entry. It sets the tkPriv(selectFilePath) global
#	variable so that the vwait loop in tkMotifFDialog will be
#	terminated.
#
# Arguments:
# 	w		The pathname of the dialog box.
#
# Results:
#	None.	

proc tkMotifFDialog_ActivateSEnt {w} {
    global tkPriv
    upvar ::tk::dialog::file::[winfo name $w] data

    set selectFilePath [string trim [$data(sEnt) get]]
    set selectFile     [file tail    $selectFilePath]
    set selectPath     [file dirname $selectFilePath]

    if {[string equal $selectFilePath ""]} {
	tkMotifFDialog_FilterCmd $w
	return
    }

    if {[file isdirectory $selectFilePath]} {
	set data(selectPath) [glob $selectFilePath]
	set data(selectFile) ""
	tkMotifFDialog_Update $w
	return
    }

    if {[string compare [file pathtype $selectFilePath] "absolute"]} {
	tk_messageBox -icon warning -type ok \
	    -message "\"$selectFilePath\" must be an absolute pathname"
	return
    }

    if {![file exists $selectPath]} {
	tk_messageBox -icon warning -type ok \
	    -message "Directory \"$selectPath\" does not exist."
	return
    }

    if {![file exists $selectFilePath]} {
	if {[string equal $data(type) open]} {
	    tk_messageBox -icon warning -type ok \
		-message "File \"$selectFilePath\" does not exist."
	    return
	}
    } else {
	if {[string equal $data(type) save]} {
	    set message [format %s%s \
		"File \"$selectFilePath\" already exists.\n\n" \
		"Replace existing file?"]
	    set answer [tk_messageBox -icon warning -type yesno \
		-message $message]
	    if {[string equal $answer "no"]} {
		return
	    }
	}
    }

    set tkPriv(selectFilePath) $selectFilePath
    set tkPriv(selectFile)     $selectFile
    set tkPriv(selectPath)     $selectPath
}


proc tkMotifFDialog_OkCmd {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    tkMotifFDialog_ActivateSEnt $w
}

proc tkMotifFDialog_FilterCmd {w} {
    upvar ::tk::dialog::file::[winfo name $w] data

    tkMotifFDialog_ActivateFEnt $w
}

proc tkMotifFDialog_CancelCmd {w} {
    global tkPriv

    set tkPriv(selectFilePath) ""
    set tkPriv(selectFile)     ""
    set tkPriv(selectPath)     ""
}

proc tkListBoxKeyAccel_Set {w} {
    bind Listbox <Any-KeyPress> ""
    bind $w <Destroy> [list tkListBoxKeyAccel_Unset $w]
    bind $w <Any-KeyPress> [list tkListBoxKeyAccel_Key $w %A]
}

proc tkListBoxKeyAccel_Unset {w} {
    global tkPriv

    catch {after cancel $tkPriv(lbAccel,$w,afterId)}
    catch {unset tkPriv(lbAccel,$w)}
    catch {unset tkPriv(lbAccel,$w,afterId)}
}

# tkListBoxKeyAccel_Key--
#
#	This procedure maintains a list of recently entered keystrokes
#	over a listbox widget. It arranges an idle event to move the
#	selection of the listbox to the entry that begins with the
#	keystrokes.
#
# Arguments:
# 	w		The pathname of the listbox.
#	key		The key which the user just pressed.
#
# Results:
#	None.	

proc tkListBoxKeyAccel_Key {w key} {
    global tkPriv

    append tkPriv(lbAccel,$w) $key
    tkListBoxKeyAccel_Goto $w $tkPriv(lbAccel,$w)
    catch {
	after cancel $tkPriv(lbAccel,$w,afterId)
    }
    set tkPriv(lbAccel,$w,afterId) [after 500 \
	    [list tkListBoxKeyAccel_Reset $w]]
}

proc tkListBoxKeyAccel_Goto {w string} {
    global tkPriv

    set string [string tolower $string]
    set end [$w index end]
    set theIndex -1

    for {set i 0} {$i < $end} {incr i} {
	set item [string tolower [$w get $i]]
	if {[string compare $string $item] >= 0} {
	    set theIndex $i
	}
	if {[string compare $string $item] <= 0} {
	    set theIndex $i
	    break
	}
    }

    if {$theIndex >= 0} {
	$w selection clear 0 end
	$w selection set $theIndex $theIndex
	$w activate $theIndex
	$w see $theIndex
    }
}

proc tkListBoxKeyAccel_Reset {w} {
    global tkPriv

    catch {unset tkPriv(lbAccel,$w)}
}