summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog19
-rw-r--r--library/choosedir.tcl129
-rw-r--r--library/tclIndex2
-rw-r--r--library/tk.tcl4
4 files changed, 103 insertions, 51 deletions
diff --git a/ChangeLog b/ChangeLog
index 1cfa617..f054b89 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2000-02-01 Eric Melski <ericm@scriptics.com>
+
+ * library/tk.tcl:
+ * library/tclIndex:
+ * library/choosedir.tcl: Moved choosedir functions into the
+ ::tk::dialog::chooseDir namespace instead of a toplevel
+ ::tkChooseDirectory namespace. Additional cleanup on the
+ chooseDir dialog.
+
2000-02-01 Jeff Hobbs <hobbs@scriptics.com>
* doc/text.n: clarified docs on what happens during a search with
@@ -32,6 +41,16 @@
* unix/aclocal.m4: added *BSD ELF recognition for
SHARED_LIB_SUFFIX determination (from Tcl's tcl.m4)
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgPhoto.c: Removed unneccesary object translation in
+ MatchStringFormat (bug #4103).
+
+2000-01-27 Eric Melski <ericm@scriptics.com>
+
+ * generic/tkImgGIF.c: Additional code cleanup (now we only have
+ one decoder! neat!)
+
2000-01-26 Eric Melski <ericm@scriptics.com>
* doc/getOpenFile.n:
diff --git a/library/choosedir.tcl b/library/choosedir.tcl
index fb92599..724b33c 100644
--- a/library/choosedir.tcl
+++ b/library/choosedir.tcl
@@ -6,43 +6,83 @@
# 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 $
+# RCS: @(#) $Id: choosedir.tcl,v 1.2 2000/02/01 23:23:21 ericm Exp $
-package require opt
+# Make sure the tk::dialog namespace, in which all dialogs should live, exists
+namespace eval ::tk::dialog {}
-namespace eval ::tkChooseDirectory {
+# Make the chooseDir namespace inside the dialog namespace
+namespace eval ::tk::dialog::chooseDir {
+ # value is an array that holds the current selection value for each dialog
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]
- }
+proc ::tk::dialog::chooseDir::tkChooseDirectory { args } {
+ variable value
+ # Error messages
+ append err(usage) "tk_chooseDirectory "
+ append err(usage) "?-initialdir directory? ?-mustexist? "
+ append err(usage) "?-parent window? ?-title title?"
+
+ set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
+ set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
+ set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
+
+ # Default values
+ set opts(-initialdir) [pwd]
+ set opts(-mustexist) 0
+ set opts(-parent) .
+ set opts(-title) "Choose Directory"
+
+ # Process args
+ set len [llength $args]
+ for { set i 0 } { $i < $len } {incr i} {
+ set flag [lindex $args $i]
+ incr i
+ switch -glob -- $flag {
+ "-initialdir" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ "-mustexist" {
+ set opts($flag) 1
+ incr i -1
+ }
+ "-parent" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ "-title" {
+ if { $i >= $len } {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ default {
+ error [format $err(unknownOpt) [lindex $args $i]]
+ }
+ }
+ }
+
# Handle default parent window
- if {[string compare $parent "."] == 0} {
- set parent ""
+ if {[string equal $opts(-parent) "."]} {
+ set opts(-parent) ""
}
- set w [toplevel $parent.choosedirectory]
- wm title $w $title
+ set w [toplevel $opts(-parent).choosedirectory]
+ wm title $w $opts(-title)
# Commands for various bindings (which follow)
set okCommand [namespace code \
- [list Done $w ok ::tkChooseDirectory::value($w)]]
+ [list Done $w ok $opts(-mustexist)]]
set cancelCommand [namespace code \
- [list Done $w cancel ::tkChooseDirectory::value($w)]]
+ [list Done $w cancel $opts(-mustexist)]]
# Create controls.
set lbl [label $w.l -text "Directory name:" -anchor w]
@@ -80,7 +120,7 @@ namespace eval ::tkChooseDirectory {
grid columnconfigure . 0 -weight 1
grid columnconfigure . 1 -weight 1
- $ent insert end $initialdir
+ $ent insert end $opts(-initialdir)
# Set bindings
# <Return> is the same as OK
@@ -93,7 +133,7 @@ namespace eval ::tkChooseDirectory {
wm protocol $w WM_DELETE_WINDOW $cancelCommand
# Fill listbox and bind for browsing
- Refresh $lst $initialdir
+ Refresh $lst $opts(-initialdir)
bind $lst <Return> [namespace code [list Update $ent $lst]]
bind $lst <Double-ButtonRelease-1> [namespace code [list Update $ent $lst]]
@@ -113,13 +153,13 @@ namespace eval ::tkChooseDirectory {
grab release $w
- set dir $::tkChooseDirectory::value($w)
- unset ::tkChooseDirectory::value($w)
+ set dir $value($w)
+ unset value($w)
return $dir
}
# tkChooseDirectory::tk_chooseDirectory
-proc ::tkChooseDirectory::MinSize { w } {
+proc ::tk::dialog::chooseDir::MinSize { w } {
set geometry [wm geometry $w]
regexp {([0-9]*)x([0-9]*)\+} geometry whole width height
@@ -127,13 +167,21 @@ proc ::tkChooseDirectory::MinSize { w } {
wm minsize $w $width $height
}
-proc ::tkChooseDirectory::Done { w why varName } {
+proc ::tk::dialog::chooseDir::Done { w why mustexist } {
variable value
switch -- $why {
ok {
- # If mustexist, validate with [cd]
+ # If mustexist, validate value
set value($w) [$w.e get]
+ if { $mustexist } {
+ if { ![file exists $value($w)] } {
+ return
+ }
+ if { ![file isdirectory $value($w)] } {
+ return
+ }
+ }
}
cancel {
set value($w) ""
@@ -143,7 +191,7 @@ proc ::tkChooseDirectory::Done { w why varName } {
destroy $w
}
-proc ::tkChooseDirectory::Refresh { listbox dir } {
+proc ::tk::dialog::chooseDir::Refresh { listbox dir } {
$listbox delete 0 end
# Find the parent directory; if it is different (ie, we're not
@@ -161,13 +209,13 @@ proc ::tkChooseDirectory::Refresh { listbox dir } {
}
}
-proc ::tkChooseDirectory::Update { entry listbox } {
+proc ::tk::dialog::chooseDir::Update { entry listbox } {
set sel [$listbox curselection]
if { [string equal $sel ""] } {
return
}
set subdir [$listbox get $sel]
- if {[string compare $subdir ".."] == 0} {
+ if {[string equal $subdir ".."]} {
set fullpath [file dirname [$entry get]]
if { [string equal $fullpath [$entry get]] } {
return
@@ -179,18 +227,3 @@ proc ::tkChooseDirectory::Update { entry listbox } {
$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 d0d2407..5a8cb43 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -242,4 +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]]
+set auto_index(::tk::dialog::chooseDir::tkChooseDirectory) [list source [file join $dir choosedir.tcl]]
diff --git a/library/tk.tcl b/library/tk.tcl
index e5347cc..be7b23e 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.17 2000/01/27 00:23:10 ericm Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.18 2000/02/01 23:23:21 ericm Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -256,7 +256,7 @@ if {[string equal [info commands tk_messageBox] ""]} {
}
if {[string equal [info command tk_chooseDirectory] ""]} {
proc tk_chooseDirectory {args} {
- return [eval ::tkChooseDirectory::tk_chooseDirectory $args]
+ return [eval ::tk::dialog::chooseDir::tkChooseDirectory $args]
}
}