Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Namespace Members | Class Members | File Members | Related Pages

allfiles.tcl

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 ## &lt;annotation&gt; .... &lt;/annotation&gt;. 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 {//parse[1]/ref[@type="Lattice"]/@name} ] 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 # ----------------------------------------------------------------------------

XCDG 0.95 (20 Oct 2004)