summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-01-27 00:23:10 (GMT)
committerericm <ericm>2000-01-27 00:23:10 (GMT)
commit40b335d9b0c6ca46aa6f5bba4f95528fea233129 (patch)
treee9779997eb2be15e478fc405ca04237abcb9a671
parent7e47234206a345a0b8dcbe7bd066ed360e4a9942 (diff)
downloadtk-40b335d9b0c6ca46aa6f5bba4f95528fea233129.zip
tk-40b335d9b0c6ca46aa6f5bba4f95528fea233129.tar.gz
tk-40b335d9b0c6ca46aa6f5bba4f95528fea233129.tar.bz2
* doc/getOpenFile.n:
* doc/chooseDirectory.n: Man page/cross links for tk_chooseDirectory (bug #1786). * library/tk.tcl: * library/tclIndex: Added hooks for tk_chooseDirectory. (bug #1786) * library/choosedir.tcl: tk_chooseDirectory implementation for Unix/Mac (bug #1786).
-rw-r--r--doc/chooseDirectory.n52
-rw-r--r--doc/getOpenFile.n5
-rw-r--r--library/choosedir.tcl196
-rw-r--r--library/tclIndex1
-rw-r--r--library/tk.tcl7
-rw-r--r--unix/mkLinks4
6 files changed, 263 insertions, 2 deletions
diff --git a/doc/chooseDirectory.n b/doc/chooseDirectory.n
new file mode 100644
index 0000000..42bf636
--- /dev/null
+++ b/doc/chooseDirectory.n
@@ -0,0 +1,52 @@
+'\"
+'\" Copyright (c) 1998-2000 by Scriptics Corporation.
+'\" All rights reserved.
+'\"
+'\" RCS: @(#) $Id: chooseDirectory.n,v 1.1 2000/01/27 00:23:10 ericm Exp $
+'\"
+.so man.macros
+.TH tk_chooseDirectory n 8.3 Tk "Tk Built-In Commands"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tk_chooseDirectory \- pops up a dialog box for the user to select a directory.
+.PP
+.SH SYNOPSIS
+\fBtk_chooseDirectory \fR?\fIoption value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedure \fBtk_chooseDirectory\fR pops up a dialog box for the
+user to select a directory. The following \fIoption\-value\fR pairs are
+possible as command line arguments:
+.TP
+\fB\-initialdir\fR \fIdirname\fR
+Specifies that the directories in \fIdirectory\fR should be displayed
+when the dialog pops up. If this parameter is not specified, then
+the directories in the current working directory are displayed. If the
+parameter specifies a relative path, the return value will convert the
+relative path to an absolute path. This option may not always work on
+the Macintosh. This is not a bug. Rather, the \fIGeneral Controls\fR
+control panel on the Mac allows the end user to override the
+application default directory.
+.TP
+\fB\-parent\fR \fIwindow\fR
+Makes \fIwindow\fR the logical parent of the dialog. The dialog
+is displayed on top of its parent window.
+.TP
+\fB\-title\fR \fItitleString\fR
+Specifies a string to display as the title of the dialog box. If this
+option is not specified, then a default title will be displayed.
+.TP
+\fB\-mustexist\fR \fIboolean\fR
+Specifies whether the user may specify non-existant directories. If
+this parameter is true, then the user may only select directories that
+already exist. The default value is \fIfalse\fR.
+.LP
+
+.SH "SEE ALSO"
+tk_getOpenFile, tk_getSaveFile
+
+.SH KEYWORDS
+directory selection dialog
diff --git a/doc/getOpenFile.n b/doc/getOpenFile.n
index 4c19e65..de17086 100644
--- a/doc/getOpenFile.n
+++ b/doc/getOpenFile.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: getOpenFile.n,v 1.4 1999/12/16 21:57:11 hobbs Exp $
+'\" RCS: @(#) $Id: getOpenFile.n,v 1.5 2000/01/27 00:23:10 ericm Exp $
'\"
.so man.macros
.TH tk_getOpenFile n 4.2 Tk "Tk Built-In Commands"
@@ -152,5 +152,8 @@ if {$filename != ""} {
}
.CE
+.SH "SEE ALSO"
+tk_chooseDirectory
+
.SH KEYWORDS
file selection dialog
diff --git a/library/choosedir.tcl b/library/choosedir.tcl
new file mode 100644
index 0000000..fb92599
--- /dev/null
+++ b/library/choosedir.tcl
@@ -0,0 +1,196 @@
+# choosedir.tcl --
+#
+# Choose directory dialog implementation for Unix/Mac. Adapted from
+# Christopher Nelson's (chris@pinebush.com) implementation.
+#
+# Copyright (c) 1998-2000 by Scriptics Corporation.
+# All rights reserved.
+#
+# RCS: @(#) $Id: choosedir.tcl,v 1.1 2000/01/27 00:23:10 ericm Exp $
+
+package require opt
+
+namespace eval ::tkChooseDirectory {
+ variable value
+}
+
+::tcl::OptProc ::tkChooseDirectory::tk_chooseDirectory {
+ {-initialdir -string ""
+ "Initial directory for browser"}
+ {-mustexist
+ "If specified, user can't type in a new directory"}
+ {-parent -string "."
+ "Parent window for browser"}
+ {-title -string "Choose Directory"
+ "Title for browser window"}
+} {
+ # Handle default directory
+ if {[string length $initialdir] == 0} {
+ set initialdir [pwd]
+ }
+
+ # Handle default parent window
+ if {[string compare $parent "."] == 0} {
+ set parent ""
+ }
+
+ set w [toplevel $parent.choosedirectory]
+ wm title $w $title
+
+ # Commands for various bindings (which follow)
+ set okCommand [namespace code \
+ [list Done $w ok ::tkChooseDirectory::value($w)]]
+
+ set cancelCommand [namespace code \
+ [list Done $w cancel ::tkChooseDirectory::value($w)]]
+
+ # Create controls.
+ set lbl [label $w.l -text "Directory name:" -anchor w]
+ set ent [entry $w.e -width 30]
+ set frm [frame $w.f]
+ set lst [listbox $frm.lb -height 8 \
+ -yscrollcommand [list $frm.sb set] \
+ -selectmode browse \
+ -setgrid true \
+ -exportselection 0 \
+ -takefocus 1]
+ set scr [scrollbar $frm.sb -orient vertical \
+ -command [list $frm.lb yview]]
+ set bOK [button $w.ok -width 8 -text OK -command $okCommand \
+ -default active]
+ set bCan [button $w.cancel -width 8 -text Cancel -command $cancelCommand]
+
+ if {[llength [file volumes]]} {
+ # On Macs it would be nice to add a volume combobox
+ }
+
+ # Place controls on window
+ set padding 4
+ grid $lst $scr -sticky nsew
+ grid columnconfigure $frm 0 -weight 1
+ grid rowconfigure $frm 0 -weight 1
+
+ grid $lbl $bOK -padx $padding -pady $padding
+ grid $ent $bCan -padx $padding -pady $padding
+ grid $frm -padx $padding -pady $padding
+
+ grid configure $lbl -sticky w
+ grid configure $ent -sticky ew
+ grid configure $frm -sticky nsew
+ grid columnconfigure . 0 -weight 1
+ grid columnconfigure . 1 -weight 1
+
+ $ent insert end $initialdir
+
+ # Set bindings
+ # <Return> is the same as OK
+ bind $w <Return> $okCommand
+
+ # <Escape> is the same as cancel
+ bind $w <Escape> $cancelCommand
+
+ # Closing the window is the same as cancel
+ wm protocol $w WM_DELETE_WINDOW $cancelCommand
+
+ # Fill listbox and bind for browsing
+ Refresh $lst $initialdir
+
+ bind $lst <Return> [namespace code [list Update $ent $lst]]
+ bind $lst <Double-ButtonRelease-1> [namespace code [list Update $ent $lst]]
+
+ ::tk::PlaceWindow $w widget [winfo parent $w]
+
+ # Set the min size when the size is known
+# tkwait visibility $w
+# tkChooseDirectory::MinSize $w
+
+ focus $ent
+ $ent selection range 0 end
+ grab set $w
+
+ # Wait for OK, Cancel or close
+ tkwait window $w
+
+ grab release $w
+
+ set dir $::tkChooseDirectory::value($w)
+ unset ::tkChooseDirectory::value($w)
+ return $dir
+}
+# tkChooseDirectory::tk_chooseDirectory
+
+proc ::tkChooseDirectory::MinSize { w } {
+ set geometry [wm geometry $w]
+
+ regexp {([0-9]*)x([0-9]*)\+} geometry whole width height
+
+ wm minsize $w $width $height
+}
+
+proc ::tkChooseDirectory::Done { w why varName } {
+ variable value
+
+ switch -- $why {
+ ok {
+ # If mustexist, validate with [cd]
+ set value($w) [$w.e get]
+ }
+ cancel {
+ set value($w) ""
+ }
+ }
+
+ destroy $w
+}
+
+proc ::tkChooseDirectory::Refresh { listbox dir } {
+ $listbox delete 0 end
+
+ # Find the parent directory; if it is different (ie, we're not
+ # already at the root), add a ".." entry
+ set parentDir [file dirname $dir]
+ if { ![string equal $parentDir $dir] } {
+ $listbox insert end ".."
+ }
+
+ # add the subdirs to the listbox
+ foreach f [lsort [glob -nocomplain $dir/*]] {
+ if {[file isdirectory $f]} {
+ $listbox insert end "[file tail $f]/"
+ }
+ }
+}
+
+proc ::tkChooseDirectory::Update { entry listbox } {
+ set sel [$listbox curselection]
+ if { [string equal $sel ""] } {
+ return
+ }
+ set subdir [$listbox get $sel]
+ if {[string compare $subdir ".."] == 0} {
+ set fullpath [file dirname [$entry get]]
+ if { [string equal $fullpath [$entry get]] } {
+ return
+ }
+ } else {
+ set fullpath [file join [$entry get] $subdir]
+ }
+ $entry delete 0 end
+ $entry insert end $fullpath
+ Refresh $listbox $fullpath
+}
+
+# Some test code
+if {[string compare [info script] $argv0] == 0} {
+ catch {rename ::tk_chooseDirectory tk_chooseDir}
+
+ proc tk_chooseDirectory { args } {
+ uplevel ::tkChooseDirectory::tk_chooseDirectory $args
+ }
+
+ wm withdraw .
+ set dir [tk_chooseDirectory -initialdir [pwd] \
+ -title "Choose a directory"]
+ tk_messageBox -message "dir:<<$dir>>"
+ exit
+}
diff --git a/library/tclIndex b/library/tclIndex
index e2cf7f1..d0d2407 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -242,3 +242,4 @@ set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]
set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(::tkChooseDirectory::tk_chooseDirectory) [list source [file join $dir choosedir.tcl]]
diff --git a/library/tk.tcl b/library/tk.tcl
index 5c8e5cc..e5347cc 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.16 2000/01/20 02:32:52 ericm Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.17 2000/01/27 00:23:10 ericm Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -254,6 +254,11 @@ if {[string equal [info commands tk_messageBox] ""]} {
return [eval tkMessageBox $args]
}
}
+if {[string equal [info command tk_chooseDirectory] ""]} {
+ proc tk_chooseDirectory {args} {
+ return [eval ::tkChooseDirectory::tk_chooseDirectory $args]
+ }
+}
#----------------------------------------------------------------------
# Define the set of common virtual events.
diff --git a/unix/mkLinks b/unix/mkLinks
index 08e5480..975b639 100644
--- a/unix/mkLinks
+++ b/unix/mkLinks
@@ -959,6 +959,10 @@ if test -r chooseColor.n; then
rm -f tk_chooseColor.n
ln chooseColor.n tk_chooseColor.n
fi
+if test -r chooseDirectory.n; then
+ rm -f tk_chooseDirectory.n
+ ln chooseDirectory.n tk_chooseDirectory.n
+fi
if test -r dialog.n; then
rm -f tk_dialog.n
ln dialog.n tk_dialog.n