00001
# Copyright (C) 1997-2004 The CDG Team <cdg@nats.informatik.uni-hamburg.de>
00002
#
00003
# This file is free software; as a special exception the author gives
00004
# unlimited permission to copy and/or distribute it, with or without
00005
# modifications, as long as this notice is preserved.
00006
#
00007
# This program is distributed in the hope that it will be useful, but
00008
# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
00009
# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
00010
00011
## ----------------------------------------------------------------------------
00012
## AllFiles - CDG grammar file manager.
00013
## This class is responsible for all issues regarding grammar files in the xcdg
00014
## application, that is loading, reloading grammar files and xml annotaion files.
00015
##
00016
## \author Michael Daum (see also AUTHORS and THANKS for more)
00017
##
00018
## $Id: allfiles.tcl,v 1.65 2004/10/11 13:50:05 micha Exp $
00019
## ----------------------------------------------------------------------------
00020 class AllFiles {
00021 inherit
DataBrowser
00022
00023
# public methods
00024
public method
init_data {}; ##
abstract Method from
DataBrowser
00025
public method
load {args}; ## \type TclList
00026
public method
load_dir {args}; ## \type TclList
00027
public method
loadXml {filename}; ## \type TclString
00028
public method
reload {}
00029
public method
selectIdsOfFile {filename}; ## \type TclString
00030
00031 constructor {args} {}; ## \type TclList
00032
00033
00034
# protected methods
00035
protected method
_motion_action {w x y }; ## \type TclWidget,TclNumber,TclNumber
00036
00037
# private methods
00038
private method
_reload_action {}
00039
private method
_load_action {}
00040
private method
_run_action {}
00041
private method
_reset_action {}
00042
private method
_edit_action {}
00043
private method
_load {args}; ## \type TclList
00044
private method
_dom2anno {document}; ## \type DomNode
00045
00046
# private variables
00047
00048
## array holding all loaded files.
00049
private variable
_filenames; ## \type TclArray
00050
00051 ## list if recently loaded files
00052
private variable
_lastLoaded ""
00053 };
00054
00055
00056
## ----------------------------------------------------------------------------
00057
## An AllFiles constructor.
00058
## \param args arguments passed to itk_initialize
00059
## ----------------------------------------------------------------------------
00060
body AllFiles::constructor {args} {
00061 itk_component add loadbutton {
00062 button $itk_component(childsite).load \
00063 -anchor w \
00064 -text
"Load" \
00065 -command [code $this _load_action]
00066 } { }
00067
00068 itk_component add runbutton {
00069 button $itk_component(childsite).run \
00070 -anchor w \
00071 -text
"Run" \
00072 -command [code $this _run_action]
00073 } { }
00074
00075 itk_component add resetbutton {
00076 button $itk_component(childsite).reset \
00077 -anchor w \
00078 -text
"Reset" \
00079 -command [code $this _reset_action]
00080 } { }
00081
00082 itk_component add editbutton {
00083 button $itk_component(childsite).edit \
00084 -anchor w \
00085 -text
"Edit" \
00086 -command [code $this _edit_action]
00087 } { }
00088
00089 itk_component add reloadbutton {
00090 button $itk_component(childsite).reload \
00091 -anchor w \
00092 -text
"Reload" \
00093 -command [code $this _reload_action]
00094 } { }
00095
00096 pack $itk_component(loadbutton) \
00097 $itk_component(runbutton) \
00098 $itk_component(resetbutton) \
00099 $itk_component(editbutton) \
00100 $itk_component(reloadbutton) \
00101 -side left -padx 3
00102
00103 $itk_component(table) configure -titlerows 2
00104
00105 # register the helpmessages
00106 .cdgmain help sethelpstr \
00107 $itk_component(loadbutton) \
00108 "Load a new cdg-file" \
00109 $itk_component(runbutton) \
00110 "Execute a tcl-cdg-script" \
00111 $itk_component(resetbutton) \
00112 "Unload all files and destroy all related data" \
00113 $itk_component(entryfield) "Enter a filename"
00114
00115 init_data
00116 }
00117
00118 ## ----------------------------------------------------------------------------
00119 ## select row of a file.
00120 ## previous selections are cleared
00121 ## ----------------------------------------------------------------------------
00122 body
AllFiles::selectIdsOfFile {filename} {
00123 set table $itk_component(table)
00124
00125 set rmax [$table cget -rows]
00126 $table selection clear 0,0 end
00127
00128 set newselection ""
00129 for {set row 0} {$row < $rmax} {incr row} {
00130
if {[$table getCell $row,1] == $filename} {
00131 set
id [$table getCell $row,1 ]
00132 lappend newselection $id
00133 $table selection set $row,0
00134 }
00135 }
00136
00137 set _selection $newselection
00138 }
00139
00140
00141
## ----------------------------------------------------------------------------
00142
## load files and store additional information which could be acquired
00143
## ----------------------------------------------------------------------------
00144
body
AllFiles::load {args} {
00145
00146 set table $itk_component(table)
00147
00148 if {$args ==
"" } {
00149 set types {
00150 {
"CDG files" {.cd? .m4}}
00151 {
"CDG category" {.cdc}}
00152 {
"CDG lexicon" {.cdl}}
00153 {
"CDG sorts" {.cds}}
00154 {
"CDG wordgraphs" {.cdw}}
00155 {
"CDG scripts" {.run .scr}}
00156 {
"CDG Xml" {.xml.gz}}
00157 {
"All files" *}
00158 }
00159 set names [tk_getOpenFile -filetypes $types -parent .]
00160
if {$names ==
""} {
00161
return
00162 }
00163 }
else {
00164 set names $args
00165 }
00166
00167
# test arguments
00168
foreach filename $names {
00169
if {[
catch {glob $filename}]} {
00170 ::cmd::Puts
"ERROR: can't find file \"$filename\""
00171
return
00172 }
00173 }
00174
00175
# load set of files
00176
set _lastLoaded $names
00177 set basenames [_load $names]
00178 .cdgmain busy compute
"Init Files" [code $this init_data]
00179
return $basenames
00180 }
00181
00182
## ----------------------------------------------------------------------------
00183
## load all files in a directory.
00184
## \todo this method does not use the busy dialog.
00185
## ----------------------------------------------------------------------------
00186
body
AllFiles::load_dir {args} {
00187
00188 set dir [tk_chooseDirectory -parent . -mustexist 1 -title
"Load directory"]
00189
if {$dir ==
""} {
00190
return
00191 }
00192
00193
# load set of files
00194
set files [glob -type f -path
"$dir/" *]
00195 commandEval
"load $files"
00196 init_data
00197 }
00198
00199
## ----------------------------------------------------------------------------
00200
## internal load method.
00201
## This method is called while the CdgBusy box is shown.
00202
## \param args list of filenames to be loaded
00203
## \returns the list of the filenames basenames
00204
## ----------------------------------------------------------------------------
00205
body
AllFiles::_load {args} {
00206 set basenames
""
00207 foreach filename $args {
00208 set basename [file tail $filename]
00209 set basename [join [split $basename]
"\n"]
00210
if {[regexp {.*\.xml\.gz} $basename]} {
00211 .cdgmain busy compute
"Loading $basename" \
00212 [code $this loadXml $filename]
00213 }
else {
00214 .cdgmain busy compute
"Loading $basename" commandEval
"load $filename"
00215 }
00216 lappend basenames $basename
00217 }
00218
00219
# switch the notebook to the first page (files),
00220
# because the other pages may have become invalid,
00221
# but are only redrawn upon an expose event.
00222
.cdgmain tabno view 0
00223
00224
return $basename
00225 }
00226
00227
## ----------------------------------------------------------------------------
00228
## load the last loaded file again
00229
## ----------------------------------------------------------------------------
00230
body
AllFiles::reload {} {
00231 _reload_action
00232 }
00233
00234
00235
## ----------------------------------------------------------------------------
00236
## initialization of the data managed by this class.
00237
## This method refreshes the data which could have been changed elsewhere, that
00238
## is consult the C layer and squeeze out the relevant information.
00239
## ----------------------------------------------------------------------------
00240
body AllFiles::init_data {} {
00241
00242 set table $itk_component(table)
00243 $table configure -state normal
00244 $table clear all
00245 $table delete rows 3 [$table cget -rows]
00246 $table tag configure filename -anchor w
00247 $table tag col filename 1
00248 $table width 0 9 1 18 3 9 4 9 5 9 6 9 7 9 8 9
00249 $table setCell row 0,0 {
"" "Filename" "Constraints" "Levels" \
00250
"Lex.Entries" "Lattices" "Annotations" "Hierarchies" "Parameters" \
00251
"Total" }
00252 set inputCurrentGrammar [inputCurrentGrammar_get]
00253 _setCount [listSize [InputStruct_files_get $inputCurrentGrammar]]
00254
00255 array unset _filenames
00256
00257
# redraw table
00258
set count 2
00259
for {set l [InputStruct_files_get $inputCurrentGrammar]} {$l !=
"NULL"} \
00260 {set l [listNext $l]; incr count} {
00261 set filename [pointer2string [listElement $l]]
00262 set basename [file tail $filename]
00263 set _filenames($basename) $filename
00264 $table setCell $count,0 [expr $count -1]
00265 $table spans $count,1 0,8
00266 $table setCell $count,1 $basename
00267 }
00268
00269 # count stuff
00270 $table setCell 1,2 [hashSize [InputStruct_constraints_get $inputCurrentGrammar]] \
00271 1,3 [listSize [InputStruct_levels_get $inputCurrentGrammar]] \
00272 1,4 [hashSize [InputStruct_lexicon_get $inputCurrentGrammar]] \
00273 1,5 [listSize [InputStruct_lattices_get $inputCurrentGrammar]] \
00274 1,6 [hashSize [InputStruct_annotations_get $inputCurrentGrammar]] \
00275 1,7 [hashSize [InputStruct_hierarchies_get $inputCurrentGrammar]] \
00276 1,8 [listSize [InputStruct_parameters_get $inputCurrentGrammar]]
00277 $table configure -state disabled
00278 }
00279
00280 ## ----------------------------------------------------------------------------
00281 ## load slot.
00282 ## This command is executed whenever the load button is pressed. It loads
00283 ## the selected files in
AllFiles::_selection and sets the selection accordingly.
00284 ## ----------------------------------------------------------------------------
00285 body
AllFiles::_load_action {} {
00286
00287 set files [eval load $_selection]
00288 eval setSelection $files
00289 }
00290
00291
## ----------------------------------------------------------------------------
00292
## reload slot.
00293
## This command is executed whenever the load button is pressed. It resets the
00294
## cdg system before loading the files in AllFiles::_lastLoaded.
00295
## ----------------------------------------------------------------------------
00296
body AllFiles::_reload_action {} {
00297 ::cmd::Reset force
00298 set files [eval load $_lastLoaded]
00299 eval setSelection $files
00300 }
00301
00302
## ----------------------------------------------------------------------------
00303
## select a file and run it as a tcl-cdg-script
00304
## ----------------------------------------------------------------------------
00305
body AllFiles::_run_action {} {
00306
00307 set types {
00308 {
"CDG scripts" {.run .scr}}
00309 {
"CDG files" {.cd? .m4}}
00310 {
"CDG category" {.cdc}}
00311 {
"CDG lexicon" {.cdl}}
00312 {
"CDG sorts" {.cds}}
00313 {
"CDG wordgraphs" {.cdw}}
00314 {
"All files" *}
00315 }
00316 set filename [tk_getOpenFile -filetypes $types -parent .]
00317
if {$filename !=
""} {
00318 .cdgmain shell safeSource $filename
00319 }
00320 }
00321
00322
## ----------------------------------------------------------------------------
00323
## edit slot.
00324
## This method is called on and edit button press and starts an editor on the
00325
## selected filenames.
00326
## ----------------------------------------------------------------------------
00327
body
AllFiles::_edit_action {} {
00328
00329 set files
""
00330 foreach
id $_selection {
00331 append files
" $_filenames($id)"
00332 }
00333
00334 regsub -all
"%f" "/bin/sh -c \"[.cdgmain cget -editor]\"" $files command
00335
00336
if {[
catch {eval exec $command >/dev/null &} errMsg]} {
00337 ::cmd::Puts
"ERROR: $errMsg"
00338 }
00339 }
00340
00341
## ----------------------------------------------------------------------------
00342
## reset slot.
00343
## This method simply calls ::cmd::Reset.
00344
## ----------------------------------------------------------------------------
00345
body
AllFiles::_reset_action {} {
00346 ::cmd::Reset
00347 }
00348
00349
00350
## ----------------------------------------------------------------------------
00351
## motion slot.
00352
## Moving the mouse over the table extracts displays a help string in the
00353
## status line of the main window.
00354
## \param w the widget where the motion was detected
00355
## \param x the x coords of the mouse
00356
## \param y the y coords of the mouse
00357
## ----------------------------------------------------------------------------
00358
body AllFiles::_motion_action {w x y} {
00359 focus $w
00360
00361 set row [$w index @$x,$y row]
00362
if {$row < 1}
return
00363
00364 set file [$itk_component(table) getCell $row,1]
00365 if {[info exists _filenames($file)]} {
00366 set fullfilename $_filenames($file)
00367 .cdgmain help showstr $fullfilename
00368 }
00369 }
00370
00371
00372
00373
## ----------------------------------------------------------------------------
00374
## read in an xml annotation.
00375
##
00376
## \param filename the xml file containing the xml annotation
00377
##
00378
## The provided file is read, and the xml document is searched for an
00379
## <annotation> .... </annotation>. This was hopefully generated with
00380
## writeXmlAnnoEntry() .
00381
## ----------------------------------------------------------------------------
00382
body
AllFiles::loadXml {filename} {
00383
00384 # open the file and read in the raw data
00385
set fd [open
"|zcat $file" r]
00386 set data [read $fd]
00387 close $fd
00388
00389
# analyse the dom document
00390
set document [dom parse $data]
00391 set buffer [_dom2anno $document]
00392 $document
delete
00393 set document
""
00394
00395
# store the annotation into a temporary file
00396
set tempfile [exec mktemp /tmp/xcdg.XXXXXX]
00397 set fd [open $tempfile w]
00398 puts $fd $buffer
00399 close $fd
00400
00401
# load it
00402
commandEval
"load $tempfile"
00403
00404 file
delete $tempfile
00405 }
00406
00407
## ----------------------------------------------------------------------------
00408
## analyse a dom document and convert it to an annotation.
00409
##
00410
## @param document the dom document
00411
## @returns a string buffer containing the annotation in the cdg
00412
## annotation format
00413
##
00414
## This method mainly is called by @ref loadXml .
00415
## ----------------------------------------------------------------------------
00416
body AllFiles::_dom2anno {document} {
00417
00418 set result
""
00419
00420
# get the root element
00421
set cdgpNode [$document documentElement]
00422
if {$cdgpNode ==
""} {
00423
error "ERROR: no cdgp logfile\n"
00424 }
00425
00426
# get the annotation node
00427
set annoNode [$cdgpNode descendant 1
"annotation"]
00428
if {$annoNode ==
""} {
00429
error "ERROR: no annotation found in this document\n"
00430 }
00431
00432
# get annotation and latice ids
00433
set
id "[$annoNode @id]-xml"
00434
00435
# backwards compatibility
00436
if {[
catch { set latticeId
"[$annoNode @lattice]" }]} {
00437 set latticeId [$cdgpNode selectNodes \
00438 {
00439 }
00440
00441
# print all infos in this dom node
00442
append result
"'$id' : '$latticeId' <->\n"
00443 set isFirst 1
00444 foreach arcNode [$annoNode selectNodes
"arc"] {
00445
00446
if {$isFirst} {
00447 set isFirst 0
00448 }
else {
00449 append result
",\n"
00450 }
00451
00452
# get word info
00453
set from [$arcNode @from]
00454 set to [$arcNode @to]
00455 set word [$arcNode @word]
00456 regsub -all {'} $word {\'} word
00457
00458 append result [format
"%3d %3d '%s' " $from $to $word]
00459 foreach tagNode [$arcNode selectNodes
"tag"] {
00460 foreach attr [$tagNode attributes] {
00461 append result
"'$attr'/'[$tagNode getAttribute $attr]' "
00462 }
00463 }
00464 append result
"\n"
00465
00466
# get dependency info
00467
set levels
""
00468 foreach depNode [$arcNode selectNodes
"dep"] {
00469 set level [$depNode @level]
00470 set label [$depNode @label]
00471 set modifiee [$depNode @modifiee]
00472 set arc($level) [list $label $modifiee]
00473
if {[lsearch -exact $levels $level] < 0} {
00474 lappend levels $level
00475 }
00476 }
00477
00478
00479
# print dependency info
00480
foreach level $levels {
00481 set label [lindex $arc($level) 0]
00482 set modifiee [lindex $arc($level) 1]
00483 append result [format
"%10s -> %-10s -> %3d\n" \
00484 $level
"'$label'" $modifiee ]
00485 }
00486
00487 array unset arc
00488 }
00489 append result
";\n"
00490
00491
return $result
00492 }
00493
00494
# ----------------------------------------------------------------------------