From: sls <sls>
Date: Thu, 2 Feb 1995 09:44:10 +0000 (+0000)
Subject: Initial checkin from tkinspect 5.1.6
X-Git-Tag: r5_1_1~79
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=1b29af58b2fbcdf1509e36c196efbf6f128e1fe2;p=tkinspect

Initial checkin from tkinspect 5.1.6
---

diff --git a/stl-lite/filechsr.tcl b/stl-lite/filechsr.tcl
new file mode 100644
index 0000000..a994792
--- /dev/null
+++ b/stl-lite/filechsr.tcl
@@ -0,0 +1,177 @@
+#
+# $Id$
+#
+# filechooser implements a simple file chooser.
+# 
+# This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory.
+# 
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that: (1) source code distributions
+# retain the above copyright notice and this paragraph in its entirety, (2)
+# distributions including binary code include the above copyright notice and
+# this paragraph in its entirety in the documentation or other materials
+# provided with the distribution, and (3) all advertising materials mentioning
+# features or use of this software display the following acknowledgement:
+# ``This product includes software developed by the University of California,
+# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
+# the University nor the names of its contributors may be used to endorse
+# or promote products derived from this software without specific prior
+# written permission.
+# 
+# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+#
+set filechooser_shortTypes(file) "   "
+set filechooser_shortTypes(directory) DIR
+set filechooser_shortTypes(characterSpecial) CHR
+set filechooser_shortTypes(blockSpecial) BLK
+set filechooser_shortTypes(fifo) PIP
+set filechooser_shortTypes(link) LNK
+set filechooser_shortTypes(socket) SOK
+set filechooser_modeMap(0) x
+set filechooser_modeMap(1) w
+set filechooser_modeMap(2) r
+
+option add *Filechooser*Listbox*font \
+    -adobe-courier-bold-r-*-*-*-120-*-*-*-*-iso8859-*
+option add *Filechooser*status1*font \
+    -adobe-courier-bold-r-*-*-*-120-*-*-*-*-iso8859-*
+option add *Filechooser*status2*font \
+    -adobe-courier-bold-r-*-*-*-120-*-*-*-*-iso8859-*
+option add *Filechooser*Listbox*geometry 45x20
+    
+dialog filechooser {
+    param title {}
+    param filter *
+    param dirok 0       ;# set to 1 if open should accept directories
+    param newfile 0     ;# set to 1 if new files are ok
+    method create {} {
+	set w $self
+	wm minsize $w 100 100
+	frame $w.list
+	pack $w.list -in $w -side top -fill both -expand yes
+	scrollbar $w.list.sb -command "$w.list.l yview"
+	listbox $w.list.l -yscroll "$w.list.sb set" -relief raised -bd 2 \
+	    -exportselection false -selectmode single
+	pack $w.list.sb -in $w.list -side right -fill y
+	pack $w.list.l -in $w.list -side left -fill both -expand 1
+	set slot(list) $w.list.l
+	bind $w.list.l <Double-1> "$self open 1"
+	bind $w.list.l <Button-1> [bind Listbox <Button-1>]
+	foreach ev {<Button-1> <Shift-B1-Motion> <Shift-Button-1> <B1-Motion>} {
+	    bind $w.list.l $ev "+$self update_selection"
+	}
+	set b [frame $w.bottom -bd 3 -relief ridge]
+	pack $b -side top -fill both -pady 3 -padx 3
+	label $b.status1 -anchor w
+	label $b.status2 -anchor w
+	pack $b.status1 $b.status2 -side top -fill x -padx 2
+	simpleentry $b.filter -width 30 -label "Filter:"
+	$b.filter bind <Return> "$self filter \[$b.filter entry get\]"
+	$b.filter entry config -textvariable [object_slotname filter]
+	pack $b.filter -side top -fill x -padx 5
+	simpleentry $b.file -width 30 -label "File:"
+	$b.file bind <Return> "$self open 1 \[$b.file entry get\]"
+	pack $b.file -side top -fill x -pady 3 -padx 5
+	button $b.up -command "cd ..; $self fill" -text "Up"
+	button $b.open -command "$self open 0" -text "Open"
+	button $b.cancel -command "object_delete $w" -text "Cancel"
+	pack $b.open $b.up -in $b -side left -ipadx 5 -ipady 5 -padx 5 -pady 5
+	pack $b.cancel -in $b -side right -ipadx 5 -ipady 5 -padx 5 -pady 5
+    }
+    method run {} {
+	tkwait visibility $self
+	$self fill
+	set slot(result) ""
+	set old_dir [pwd]
+	while [catch {grab set $self}] {}
+	tkwait variable [object_slotname result]
+	grab release $self
+	if ![info exists slot(result)] {
+	    cd $old_dir
+	    return ""
+	}
+	cd $old_dir
+	after 0 [list object_delete $self]
+	return $slot(result)
+    }
+    method reconfig {} {
+	wm title $self $slot(title)
+	wm iconname $self $slot(title)
+    }
+    method fill {} {
+	global filechooser_shortTypes
+	set list $slot(list)
+	$list delete 0 end
+	foreach f [lsort [glob -nocomplain $slot(filter)]] {
+	    if [catch {file size $f} size] {
+		set size 0
+	    }
+	    $list insert end \
+	       [format "%s %6.1fk %s" $filechooser_shortTypes([file type $f]) \
+		 [expr $size / 1024.0] [file tail $f]]
+	}
+	$self update_selection
+    }
+    method filter {filter} {
+	set slot(filter) $filter
+	$self fill
+    }
+    method get_selection {} {
+	set l $slot(list)
+	set sel [$l curselection]
+	if {$sel == {}} return
+	set file [$l get $sel]
+	if {[llength $file] == 2} {
+	    set file [lindex $file 1]
+	} else {
+	    set file [lindex $file 2]
+	}
+	return $file
+    }
+    method update_selection {} {
+	$self.bottom.file entry delete 0 end
+	set f [$self get_selection]
+	$self.bottom.file entry insert 0 [pwd]/$f
+	if [string length $f] {
+	    global filechooser_shortTypes filechooser_modeMap
+	    file lstat $f stat
+	    for {set bit 8} {$bit >= 0} {incr bit -1} {
+		if {$stat(mode) & (1 << $bit)} {
+		    append mode $filechooser_modeMap([expr $bit % 3])
+		} else {
+		    append mode -
+		}
+	    }
+	    set msg1 \
+		[format "%s %6.1fk %s %5d %5d" \
+		 $filechooser_shortTypes($stat(type)) \
+		 [expr $stat(size) / 1024.0] $mode $stat(gid) $stat(uid)]
+	    set msg2 [file tail $f]
+	    if {$stat(type) == "link"} {
+		append msg2 " -> [file readlink $f]"
+	    }
+	} else {
+	    set msg1 ""
+	    set msg2 ""
+	}
+	$self.bottom.status1 config -text $msg1
+	$self.bottom.status2 config -text $msg2
+    }
+    method open {is_click {file ""}} {
+	if ![string length $file] {
+	    set file [$self get_selection]
+	}
+	if {$slot(newfile) && ![file exists $file]} {
+	    set slot(result) $file
+	    return
+	}
+	if {($is_click || !$slot(dirok)) && [file isdirectory $file]} {
+	    cd $file
+	    $self fill
+	    return
+	}
+	set slot(result) $file
+    }
+}