From 1b29af58b2fbcdf1509e36c196efbf6f128e1fe2 Mon Sep 17 00:00:00 2001 From: sls Date: Thu, 2 Feb 1995 09:44:10 +0000 Subject: [PATCH] Initial checkin from tkinspect 5.1.6 --- stl-lite/filechsr.tcl | 177 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 177 insertions(+) create mode 100644 stl-lite/filechsr.tcl 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 "$self open 1" + bind $w.list.l [bind Listbox ] + foreach ev { } { + 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 "$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 "$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 + } +} -- 2.23.0