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 ## AllLevels - manage CDG grammar levels 00013 ## 00014 ## 00015 ## \author Michael Daum 00016 ## $Id: alllevels.tcl,v 1.37 2004/10/11 13:50:05 micha Exp $ 00017 # ---------------------------------------------------------------------------- 00018 class AllLevels { 00019 inherit DataBrowser 00020 00021 00022 # public methods 00023 public method init_data {} 00024 public method getMainlevelId {} 00025 public method getLabels {levelId}; ## \type TclString 00026 public method getAllLevelIds {}; 00027 public method getAllSectionIds {}; 00028 00029 ## replaces getLevel 00030 public method getCData {id};## \type Level 00031 00032 public method refreshrow {row level}; ## \type TclNumber, Level 00033 00034 constructor {args} {}; ## \type TclList 00035 00036 # private methods 00037 private method _init_data {} 00038 private method displaybutton_action {} 00039 private method showbutton_action {} 00040 private method usebutton_action {} 00041 private method editbutton_action {} 00042 00043 00044 }; 00045 00046 ## ---------------------------------------------------------------------------- 00047 ## constructor 00048 ## ---------------------------------------------------------------------------- 00049 body AllLevels::constructor {args} { 00050 set _idColumnIndex 0 00051 itk_component add displaybutton { 00052 button $itk_component(childsite).display\ 00053 -anchor w \ 00054 -text "Display" \ 00055 -command [code $this displaybutton_action] 00056 } { } 00057 00058 itk_component add showbutton { 00059 button $itk_component(childsite).show\ 00060 -anchor w \ 00061 -text "Show" \ 00062 -command [code $this showbutton_action] 00063 } { } 00064 00065 itk_component add usebutton { 00066 button $itk_component(childsite).use\ 00067 -anchor w \ 00068 -text "Use" \ 00069 -command [code $this usebutton_action] 00070 } { } 00071 00072 itk_component add editbutton { 00073 button $itk_component(childsite).edit\ 00074 -anchor w \ 00075 -text "Edit" \ 00076 -command [code $this editbutton_action] 00077 } { } 00078 00079 # packing 00080 pack \ 00081 $itk_component(displaybutton) \ 00082 $itk_component(showbutton) \ 00083 $itk_component(usebutton) \ 00084 $itk_component(editbutton) \ 00085 -side left -padx 3 00086 00087 # get the initial data 00088 _init_data 00089 00090 # register the helpmessages 00091 .cdgmain help sethelpstr \ 00092 $itk_component(table) \ 00093 "Click selects row, Ctrl-Click selects more rows, NW cell selects all" \ 00094 $itk_component(displaybutton) "Print out this level in the shell" \ 00095 $itk_component(showbutton) "(Don't) display this level in constraint nets" \ 00096 $itk_component(usebutton) "(Don't) use this level in future calculations" \ 00097 $itk_component(editbutton) "Edit the declaration of this level" 00098 00099 eval itk_initialize $args 00100 } 00101 00102 00103 00104 ## ---------------------------------------------------------------------------- 00105 ## call _init_data if necessary. 00106 ## ---------------------------------------------------------------------------- 00107 body AllLevels::init_data {} { 00108 00109 if {[InputStruct_xcdglevelsToDate_get [inputCurrentGrammar_get]]} { 00110 return 00111 } 00112 00113 .cdgmain busy compute "Init Levels" [code $this _init_data] 00114 00115 } 00116 00117 ## ---------------------------------------------------------------------------- 00118 ## get data from the cdg tool 00119 ## ---------------------------------------------------------------------------- 00120 body AllLevels::_init_data {} { 00121 00122 set table $itk_component(table) 00123 $table configure -state normal 00124 $table clear all 00125 $table delete rows 1 [$table cget -rows] 00126 $table tag config default 00127 $table tag config colored -bg gray80 00128 $table width 0 8 1 13 2 4 3 4 4 4 5 4 6 4 7 4 8 4 00129 00130 $table setCell row 0,0 { "" "File" "Labels" \ 00131 "Unary" "Binary" "shown" "used" "avg. score" } 00132 00133 _setCount [listSize [InputStruct_levels_get [inputCurrentGrammar_get]]] 00134 set r 1 00135 for {set l [InputStruct_levels_get [inputCurrentGrammar_get]]} \ 00136 {$l != "NULL"} {set l [listNext $l]} { 00137 set level [listElement $l] 00138 refreshrow $r $level 00139 incr r 00140 } 00141 00142 setSelection 00143 InputStruct_xcdglevelsToDate_set [inputCurrentGrammar_get] 1 00144 00145 $table configure -state disabled 00146 } 00147 00148 00149 ## ---------------------------------------------------------------------------- 00150 ## fill a row with the values from a specific level 00151 ## ---------------------------------------------------------------------------- 00152 body AllLevels::refreshrow {row level} { 00153 set table $itk_component(table) 00154 00155 # level name 00156 set level_id [LevelStruct_id_get $level] 00157 00158 # base name of defining file 00159 regexp "\[^/\]*$" [LevelStruct_filename_get $level] basename 00160 00161 # nr of labels 00162 set labels [listSize [LevelStruct_labels_get $level]] 00163 00164 # nr of unary/binary constraints 00165 set unaries 0 00166 set binaries 0 00167 set scores 0 00168 set h [InputStruct_constraints_get [inputCurrentGrammar_get]] 00169 set m [hashListOfKeys $h] 00170 for {set l $m} { $l != "NULL" } { set l [listNext $l] } { 00171 set constraint [hashGet $h [listElement $l]] 00172 set i 0; set found 0 00173 for { set m [ConstraintStruct_vars_get $constraint] } \ 00174 { $m != "NULL" } \ 00175 { set m [listNext $m] } \ 00176 { 00177 incr i 00178 set varinfo [listElement $m] 00179 set id [VarInfoStruct_levelname_get $varinfo] 00180 if {$id == $level_id} {set found 1} 00181 } 00182 00183 if {$found == 1} { 00184 set score [ConstraintStruct_penalty_get $constraint] 00185 set scores [expr $scores + $score] 00186 if {$i == 1} {incr unaries} 00187 if {$i == 2} {incr binaries} 00188 } 00189 } 00190 listDelete $m 00191 00192 # display flag 00193 set shown [LevelStruct_showflag_get $level] 00194 if { $shown == 0 } { set shown no } 00195 if { $shown == 1 } { set shown yes } 00196 00197 # usage flag 00198 set used [LevelStruct_useflag_get $level] 00199 if { $used == 0 } { set used no } 00200 if { $used == 1 } { set used yes } 00201 00202 # average score 00203 set avgscore 0 00204 00205 # count may be uninitialized when this is called 00206 set nrconstraints [expr $unaries + $binaries] 00207 if {$nrconstraints>0} { 00208 set avgscore [format "%4.3f" [expr $scores / $nrconstraints]] 00209 } 00210 00211 $itk_component(table) setCell row $row,0 [list \ 00212 $level_id $basename $labels $unaries $binaries $shown $used $avgscore ] 00213 } 00214 00215 00216 00217 00218 ## ---------------------------------------------------------------------------- 00219 ## toggle usage of selected levels. 00220 ## ---------------------------------------------------------------------------- 00221 body AllLevels::usebutton_action {} { 00222 00223 if {$_selection == ""} return 00224 00225 foreach id $_selection { commandEval "uselevel $id" } 00226 foreach id $_selection { refreshid $id } 00227 } 00228 00229 ## ---------------------------------------------------------------------------- 00230 ## display the level in the shell 00231 ## ---------------------------------------------------------------------------- 00232 body AllLevels::displaybutton_action {} { 00233 foreach id $_selection { commandEval "level $id" } 00234 } 00235 00236 ## ---------------------------------------------------------------------------- 00237 ## toggle display of selected levels 00238 ## ---------------------------------------------------------------------------- 00239 body AllLevels::showbutton_action {} { 00240 foreach id $_selection { commandEval "showlevel $id" } 00241 foreach id $_selection { refreshid $id } 00242 } 00243 00244 ## ---------------------------------------------------------------------------- 00245 ## call editor for the declaration 00246 ## ---------------------------------------------------------------------------- 00247 body AllLevels::editbutton_action {} { 00248 # avoid flickering 00249 if {$_selection == ""} return 00250 00251 # build list of filenames 00252 set target "" 00253 foreach id $_selection { 00254 00255 # I suppose most editors grok "+<linenum> file" nowadays... 00256 set level [getLevel $id] 00257 set linenum [LevelStruct_lineNo_get $level] 00258 set filename [LevelStruct_filename_get $level] 00259 append target "+$linenum $filename " 00260 } 00261 00262 # build command line 00263 regsub -all "%f" "/bin/sh -c \"[.cdgmain cget -editor]\"" $target command 00264 00265 # execute 00266 if {[catch {eval exec $command >/dev/null &} errMsg]} { 00267 ::cmd::Puts "ERROR: $errMsg" 00268 } 00269 00270 } 00271 00272 00273 ## ---------------------------------------------------------------------------- 00274 ## get all labels of a certain level. 00275 ## ---------------------------------------------------------------------------- 00276 body AllLevels::getLabels {levelId} { 00277 set labels "" 00278 00279 set levelDecl "NULL" 00280 for {set l [InputStruct_levels_get [inputCurrentGrammar_get]]} \ 00281 {$l != "NULL"} {set l [listNext $l]} { 00282 set levelDecl [listElement $l] 00283 set thisLevelId [LevelStruct_id_get $levelDecl] 00284 if {$levelId == $thisLevelId} { 00285 break 00286 } 00287 } 00288 00289 if {$levelDecl != "NULL"} { 00290 for {set l [LevelStruct_labels_get $levelDecl]} {$l != "NULL"} \ 00291 {set l [listNext $l]} { 00292 set item [listElement $l] 00293 lappend labels [pointer2string $item ] 00294 } 00295 } 00296 00297 return $labels 00298 } 00299 00300 ## ---------------------------------------------------------------------------- 00301 ## get the name of the main level. 00302 ## ---------------------------------------------------------------------------- 00303 body AllLevels::getMainlevelId {} { 00304 set levelDecl [inputGetMainlevel [inputCurrentGrammar_get]] 00305 if {$levelDecl == "NULL"} { 00306 return "" 00307 } else { 00308 return [LevelStruct_id_get $levelDecl] 00309 } 00310 } 00311 00312 ## ---------------------------------------------------------------------------- 00313 ## get pointer to a level declaration. 00314 ## ---------------------------------------------------------------------------- 00315 body AllLevels::getCData {id} { 00316 return [findLevel $id] 00317 } 00318 00319 00320 00321 ## ---------------------------------------------------------------------------- 00322 ## Return list of all levels' names 00323 ## ---------------------------------------------------------------------------- 00324 body AllLevels::getAllLevelIds {} { 00325 for {set l [InputStruct_levels_get [inputCurrentGrammar_get]]} \ 00326 {$l != "NULL"} \ 00327 {set l [listNext $l]} { 00328 set i [LevelStruct_id_get [listElement $l]] 00329 lappend result $i 00330 } 00331 return $result 00332 } 00333 00334 ## ---------------------------------------------------------------------------- 00335 ## Return list of all sections' names 00336 ## ---------------------------------------------------------------------------- 00337 body AllLevels::getAllSectionIds {} { 00338 for {set l [inputSections_get]} {$l != "NULL"} {set l [listNext $l]} { 00339 set i [SectionStruct_id_get [listElement $l]] 00340 lappend result $i 00341 } 00342 return $result 00343 }