1
# This file is part of Malaga, a system for Natural Language Analysis.
2
# Copyright (C) 1995-1998 Bjoern Beutel
5
# Universitaet Erlangen-Nuernberg
6
# Abteilung fuer Computerlinguistik
9
# e-mail: malaga@linguistik.uni-erlangen.de
11
# This program is free software; you can redistribute it and/or modify
12
# it under the terms of the GNU General Public License as published by
13
# the Free Software Foundation; either version 2 of the License, or
14
# (at your option) any later version.
16
# This program is distributed in the hope that it will be useful,
17
# but WITHOUT ANY WARRANTY; without even the implied warranty of
18
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19
# GNU General Public License for more details.
21
# You should have received a copy of the GNU General Public License
22
# along with this program; if not, write to the Free Software
23
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25
# description =================================================================
27
# Implements a file selector box.
30
# $selector(name) -- name of file that has been selected
31
# $selector(dir) -- path of directory that has been selected
32
# $selector(finished) -- 1 if selector can finish now, else 0
34
# functions ===================================================================
36
proc select_file {{title "Select file:"} {default_name ""} {default_dir ""}} {
37
# Select a path name. The path is returned.
41
set font "-*-helvetica-medium-r-normal-*-17-*-*-*-*-*-iso8859-1"
43
if {$default_dir == ""} {set default_dir [pwd]}
45
# Build file selector window.
47
wm geometry .selector 350x300
48
wm title .selector $title
49
wm maxsize .selector 1000 1000
50
wm minsize .selector 100 100
52
# Create "ok" and "cancel" widget
53
frame .selector.ok_cancel
54
button .selector.ok_cancel.ok \
59
set selector(name) [.selector.file.file get]
60
set selector(dir) [.selector.dir.dir get]
61
set selector(finished) 1
63
button .selector.ok_cancel.cancel \
70
set selector(finished) 1
72
pack append .selector.ok_cancel \
73
.selector.ok_cancel.ok {left fill expand} \
74
.selector.ok_cancel.cancel {left fill expand}
76
# Create the dir string widget
78
label .selector.dir.dir_label -font $font -text "Dir:"
79
entry .selector.dir.dir -relief raised -font $font
80
bind .selector.dir.dir <Return> {show_files}
81
.selector.dir.dir insert 0 $default_dir
82
pack append .selector.dir \
83
.selector.dir.dir_label {left} \
84
.selector.dir.dir {left fill expand}
86
# Create the file listbox.
87
frame .selector.files -relief raised
88
scrollbar .selector.files.hscroll \
90
-command ".selector.files.listbox xview"
91
scrollbar .selector.files.vscroll \
93
-command ".selector.files.listbox yview"
94
listbox .selector.files.listbox \
96
-exportselection false \
98
-xscrollcommand {.selector.files.hscroll set} \
99
-yscrollcommand {.selector.files.vscroll set}
100
pack append .selector.files \
101
.selector.files.vscroll {right filly} \
102
.selector.files.hscroll {bottom fillx} \
103
.selector.files.listbox {left fill expand}
104
bind .selector.files.listbox <ButtonPress-1> "file_select_click %y"
105
bind .selector.files.listbox <Button1-Motion> "file_select_click %y"
106
bind .selector.files.listbox <Double-Button-1> "file_select_double_click %y"
109
label .selector.file.file_label -font $font -text "File:"
110
entry .selector.file.file -font $font -relief raised
111
.selector.file.file delete 0 end
112
.selector.file.file insert 0 $default_name
113
bind .selector.file.file <Return> {
115
set selector(name) [.selector.file.file get]
116
set selector(dir) [.selector.dir.dir get]
117
set selector(finished) 1
119
pack append .selector.file \
120
.selector.file.file_label {left} \
121
.selector.file.file {left fill expand}
124
pack append .selector \
125
.selector.ok_cancel {bottom fill} \
126
.selector.file {bottom fill} \
127
.selector.dir {top fill} \
128
.selector.files {top fill expand}
131
focus .selector.file.file
136
set selector(finished) 0
137
tkwait variable selector(finished)
141
set selector(name) [string trim $selector(name)]
142
set selector(dir) [string trimright [string trim $selector(dir)] "/"]
143
if {$selector(name) == ""} {
144
return $selector(dir)
145
} else {return "$selector(dir)/$selector(name)"}
148
#------------------------------------------------------------------------------
150
proc file_select_click {position} {
151
# Select a file name by mouse click.
153
set entry_number [.selector.files.listbox nearest $position]
154
if {$entry_number >= 0} {
155
set entry [string trimright [string trim [.selector.files.listbox get \
156
$entry_number]] "/@*"]
157
set dir [string trimright [string trim [.selector.dir.dir get]] "/"]
159
if [is_file "$dir/$entry"] {
160
.selector.file.file delete 0 end
161
.selector.file.file insert 0 $entry
166
#------------------------------------------------------------------------------
168
proc file_select_double_click {position} {
169
# Select a file name by mouse double click.
173
set entry_number [.selector.files.listbox nearest $position]
174
if {$entry_number >= 0} {
175
set entry [string trimright [string trim [.selector.files.listbox get \
176
$entry_number]] "/@*"]
177
set dir [string trimright [string trim [.selector.dir.dir get]] "/"]
179
if [is_file "$dir/$entry"] {
180
set selector(name) $entry
181
set selector(dir) $dir
182
set selector(finished) 1
183
} elseif {[is_directory "$dir/$entry"] \
184
&& [file executable "$dir/$entry"]} {
185
.selector.dir.dir delete 0 end
186
if {$entry == ".."} {
187
.selector.dir.dir insert 0 [file dirname $dir]
188
} else {.selector.dir.dir insert 0 "$dir/$entry"}
194
#------------------------------------------------------------------------------
197
# Show the file list.
199
set dir "[string trimright [string trim [.selector.dir.dir get]] "/"]/"
200
.selector.dir.dir delete 0 end
201
.selector.dir.dir insert 0 $dir
203
.selector.files.listbox delete 0 end
205
if {! [catch {exec ls -F $dir} directory]} {
206
if {"$dir" != "/"} {.selector.files.listbox insert end "../"}
207
foreach dir_entry [lsort $directory] {
208
if {"$dir_entry" != "../" && "$dir_entry" != "./"} {
209
.selector.files.listbox insert end $dir_entry
215
#------------------------------------------------------------------------------
217
proc is_directory {path_name} {
218
# Return 1 if "path_name" is a directory or a symbolic link to a directory.
220
# Go through link list...
221
if [catch "file type $path_name" file_type] {return 0}
222
while {"$file_type" == "link"} {
223
set path_name [file readlink $path_name]
224
if [catch "file type $path_name" file_type] {return 0}
227
return [file isdirectory $path_name]
230
#------------------------------------------------------------------------------
232
proc is_file {path_name} {
233
# Return 1 if "path_name" is a file or a symbolic link to a file.
235
# Go through link list.
236
if [catch "file type $path_name" file_type] {return 0}
237
while {"$file_type" == "link"} {
238
set path_name [file readlink $path_name]
239
if [catch "file type $path_name" file_type] {return 0}
242
return [file isfile $path_name]
245
# end of file =================================================================
added
removed
tcl/selector.tcl
